Paso 5- Trayectorias de hospitalización y mortalidad con foco en condiciones vinculadas a trastornos de salud mental y consumo de sustancias posterior a un primer ingreso por alguno de estos trastornos, en usuarios/as jóvenes y adultos emergentes de población general y pertenecientes a pueblos originarios, 2018-2021, Chile
Representar las mejores opciones de agrupamiento, junto con su relación con otras variables (para poster)
Author
Andrés González Santa Cruz
Published
October 2, 2024
Configurar
Code
# remover objetos y memoria utilizadarm(list=ls());gc()
used (Mb) gc trigger (Mb) max used (Mb)
Ncells 598995 32.0 1285497 68.7 841053 45.0
Vcells 1160262 8.9 8388608 64.0 1876493 14.4
#elegir repositorioif(Sys.info()["sysname"]=="Windows"){options(repos =c(CRAN ="https://cran.dcc.uchile.cl/"))}options(install.packages.check.source ="yes") # Chequea la fuente de los paquetes#borrar caché#system("fc-cache -f -v")if(!require(pacman)){install.packages("pacman");require(pacman)}pacman::p_unlock(lib.loc =.libPaths()) #para no tener problemas reinstalando paquetesif(Sys.info()["sysname"]=="Windows"){if (getRversion() !="4.4.0") { stop("Requiere versión de R 4.4.0. Actual: ", getRversion()) }}if(!require(job)){install.packages("job");require(job)}if(!require(kableExtra)){install.packages("kableExtra");require(kableExtra)}if(!require(tidyverse)){install.packages("tidyverse");require(tidyverse)}if(!require(cluster)){install.packages("cluster"); require(cluster)}if(!require(WeightedCluster)){install.packages("WeightedCluster"); require(WeightedCluster)}if(!require(devtools)){install.packages("devtools"); require(devtools)}if(!require(TraMineR)){install.packages("TraMineR"); require(TraMineR)}if(!require(TraMineRextras)){install.packages("TraMineRextras"); require(TraMineRextras)}if(!require(NbClust)){install.packages("NbClust"); require(NbClust)}if(!require(haven)){install.packages("haven"); require(haven)}if(!require(ggseqplot)){install.packages("ggseqplot"); require(ggseqplot)}if(!require(gridExtra)){install.packages("gridExtra"); require(gridExtra)}if(!require(Tmisc)){install.packages("Tmisc"); require(Tmisc)}if(!require(factoextra)){install.packages("factoextra"); require(factoextra)}if(!require(stargazer)){install.packages("stargazer"); require(stargazer)}if(!require(gtsummary)){install.packages("gtsummary"); require(gtsummary)}if(!require(lmtest)){install.packages("lmtest"); require(lmtest)}if(!require(emmeans)){install.packages("emmeans"); require(emmeans)}if(!require(fpp2)){install.packages("fpp2"); require(fpp2)}if(!require(purrr)){install.packages("purrr"); require(purrr)}if(!require(forecast)){install.packages("forecast"); require(forecast)}if(!require(magrittr)){install.packages("magrittr"); require(magrittr)}if(!require(foreach)){install.packages("foreach"); require(foreach)}if(!require(doParallel)){install.packages("doParallel"); require(doParallel)}if(!require(progressr)){install.packages("progressr"); require(progressr)}if(!require(chisq.posthoc.test)){devtools::install_github("ebbertd/chisq.posthoc.test")}if(!require(rstatix)){install.packages("rstatix"); require(rstatix)}seq_mean_t_dos_grupos <-function(bd =NULL, group1, group2) {# Agrupar por ambas variables resultados <-by(bd, list(group1, group2), seqmeant)# Obtener todas las combinaciones posibles de los grupos combinaciones <-expand.grid(group1 =unique(group1), group2 =unique(group2), stringsAsFactors =FALSE)# Extraer los resultados y asociarlos con las combinaciones resultados_df <-do.call(rbind, lapply(seq_along(resultados), function(i) { group_name1 <-attr(resultados, "dimnames")[[1]][i] group_name2 <-attr(resultados, "dimnames")[[2]][i]data.frame(factor_inclusivo_1 = group_name1, factor_inclusivo_2 = group_name2, Mean = resultados[[i]]) }))# Unir los resultados con las combinaciones para rellenar los valores faltantes final_df <-merge(combinaciones, resultados_df, by.x =c("group1", "group2"), by.y =c("factor_inclusivo_1", "factor_inclusivo_2"), all.x =TRUE)return(final_df)}multinom_pivot_wider <-function(x) {# check inputs match expectatations# create tibble of results df <- tibble::tibble(outcome_level =unique(x$table_body$groupname_col)) df$tbl <- purrr::map( df$outcome_level,function(lvl) { gtsummary::modify_table_body( x, ~dplyr::filter(.x, .data$groupname_col %in% lvl) %>% dplyr::ungroup() %>% dplyr::select(-.data$groupname_col) ) } )tbl_merge(df$tbl, tab_spanner =paste0("**", df$outcome_level, "**"))}best_subset_multinom <-function(y, x.vars, data) {# y Nombre de la variable dependiente (cadena de texto)# x.vars Vector de nombres de predictores (caracter)# data Dataframe con los datos de entrenamiento# Cargar las librerías necesariasrequire(dplyr)require(purrr)require(tidyr)require(nnet)require(MASS)# Generar todas las combinaciones posibles de predictores predictors_list <-lapply(1:length(x.vars), function(i) {combn(x.vars, i, simplify =FALSE) }) %>%unlist(recursive =FALSE)# Inicializar una lista para almacenar los resultados results <-list()# Iterar sobre cada combinación de predictoresfor (i inseq_along(predictors_list)) { predictors <- predictors_list[[i]] formula <-as.formula(paste(y, "~", paste(predictors, collapse ="+")))# Ajustar el modelo multinomial model <-tryCatch( nnet::multinom(formula, data = data, trace =FALSE),error =function(e) NULL )# Si el modelo se ajustó correctamente, almacenar los resultadosif (!is.null(model)) {# Extraer el AIC del modelo aic <-AIC(model)# Almacenar la información en una lista results[[length(results) +1]] <-list(predictors = predictors,model = model,AIC = aic ) } }# Convertir la lista de resultados en un dataframe results_df <- results %>% purrr::map_df(function(res) {data.frame(predictors =paste(res$predictors, collapse ="+"),AIC = res$AIC,stringsAsFactors =FALSE ) })# Ordenar los modelos por AIC de menor a mayor results_df <- results_df %>%arrange(AIC)return(results_df)}best_subset_multinom_interactions <-function(y, x.vars, data) {# y Nombre de la variable dependiente (cadena de texto)# x.vars Vector de nombres de predictores (caracter)# data Dataframe con los datos de entrenamiento# Cargar las librerías necesariasrequire(dplyr)require(purrr)require(tidyr)require(nnet)require(MASS)# Generar todas las combinaciones posibles de predictores (efectos principales) main_effects_list <-lapply(1:length(x.vars), function(i) {combn(x.vars, i, simplify =FALSE) }) %>%unlist(recursive =FALSE)# Inicializar una lista para almacenar los resultados results <-list()# Iterar sobre cada combinación de efectos principalesfor (main_effects in main_effects_list) {# Generar términos de interacción de hasta 3 variables interaction_terms <-list()# Para interacciones de 2 variablesif (length(main_effects) >=2) { interaction_terms_2way <-combn(main_effects, 2, function(x) paste(x, collapse =":")) interaction_terms <-c(interaction_terms, interaction_terms_2way) }# Para interacciones de 3 variablesif (length(main_effects) >=3) { interaction_terms_3way <-combn(main_effects, 3, function(x) paste(x, collapse =":")) interaction_terms <-c(interaction_terms, interaction_terms_3way) }# Combinar efectos principales e interacciones all_terms <-c(main_effects, interaction_terms)# Generar todas las combinaciones posibles de términos (incluyendo interacciones)# Solo se incluyen interacciones si sus efectos principales están presentes term_combinations <-list()# Obtener todos los subconjuntos de efectos principales main_effects_subsets <-lapply(1:length(main_effects), function(i) {combn(main_effects, i, simplify =FALSE) }) %>%unlist(recursive =FALSE)# Para cada subconjunto de efectos principalesfor (me in main_effects_subsets) {# Iniciar con los efectos principales terms <- me# Incluir interacciones solo si todos sus efectos principales están incluidos possible_interactions <- interaction_terms[sapply(interaction_terms, function(x) { vars_in_interaction <-unlist(strsplit(x, ":"))all(vars_in_interaction %in% me) }) ]# Generar todas las combinaciones de interacciones para incluir interaction_subsets <-list(NULL)if (length(possible_interactions) >0) { interaction_subsets <-lapply(1:length(possible_interactions), function(i) {combn(possible_interactions, i, simplify =FALSE) }) %>%unlist(recursive =FALSE) }# Para cada combinación de interacciones, crear el conjunto completo de términosfor (ints in interaction_subsets) {if (is.null(ints)) { full_terms <- terms } else { full_terms <-c(terms, ints) }# Añadir a la lista de combinaciones de términos term_combinations <-append(term_combinations, list(full_terms)) } }# Ajustar modelos para cada combinación de términosfor (terms in term_combinations) { formula <-as.formula(paste(y, "~", paste(terms, collapse ="+")))# Ajustar el modelo multinomial model <-tryCatch( nnet::multinom(formula, data = data, trace =FALSE),error =function(e) NULL,warning =function(w) NULL )# Si el modelo se ajustó correctamente, almacenar los resultadosif (!is.null(model)) {# Extraer el BIC del modelo bic <-BIC(model)# Almacenar la información en la lista de resultados results[[length(results) +1]] <-list(predictors =paste(terms, collapse =" + "),model = model,BIC = bic ) } } }# Convertir la lista de resultados en un dataframe results_df <- results %>% purrr::map_df(function(res) {data.frame(predictors = res$predictors,BIC = res$BIC,stringsAsFactors =FALSE ) })# Ordenar los modelos por BIC de menor a mayor results_df <- results_df %>%arrange(BIC)return(results_df)}best_subset_multinom_interactions_parallel <-function(y, x.vars, data) {# y Nombre de la variable dependiente (cadena de texto)# x.vars Vector de nombres de predictores (caracter)# data Dataframe con los datos de entrenamiento# Cargar las librerías necesarias dentro de la funciónrequire(dplyr)require(purrr)require(tidyr)require(nnet)require(MASS)require(foreach)require(doParallel)require(progressr)# Iniciar los gestores de progresohandlers(global =TRUE)handlers("txt")# Generar todas las combinaciones posibles de predictores (efectos principales) main_effects_list <-lapply(1:length(x.vars), function(i) {combn(x.vars, i, simplify =FALSE) }) %>%unlist(recursive =FALSE)# Inicializar una lista para almacenar las fórmulas de los modelos formulas_list <-list()# Generar todas las fórmulas posibles con interacciones hasta de 3 variablesfor (main_effects in main_effects_list) {# Generar términos de interacción de hasta 3 variables interaction_terms <-character(0) # Aseguramos que es un vector de caracteres# Para interacciones de 2 variablesif (length(main_effects) >=2) { interaction_terms_2way <-combn(main_effects, 2, function(x) paste(x, collapse =":"), simplify =TRUE) interaction_terms <-c(interaction_terms, interaction_terms_2way) }# Para interacciones de 3 variablesif (length(main_effects) >=3) { interaction_terms_3way <-combn(main_effects, 3, function(x) paste(x, collapse =":"), simplify =TRUE) interaction_terms <-c(interaction_terms, interaction_terms_3way) }# Generar todas las combinaciones posibles de efectos principales main_effects_subsets <-lapply(1:length(main_effects), function(i) {combn(main_effects, i, simplify =FALSE) }) %>%unlist(recursive =FALSE)# Para cada subconjunto de efectos principalesfor (me in main_effects_subsets) {# Iniciar con los efectos principales terms <- me# Identificar interacciones cuyos efectos principales están en 'me'if (length(interaction_terms) >0) { possible_interactions <- interaction_terms[vapply(interaction_terms, function(x) { vars_in_interaction <-unlist(strsplit(x, ":"))all(vars_in_interaction %in% me) }, FUN.VALUE =logical(1)) ] } else { possible_interactions <-character(0) }# Generar todas las combinaciones posibles de estas interacciones interaction_subsets <-list(character(0)) # Incluir el caso sin interaccionesif (length(possible_interactions) >0) { interaction_combinations <-lapply(1:length(possible_interactions), function(i) {combn(possible_interactions, i, simplify =FALSE) }) %>%unlist(recursive =FALSE) interaction_subsets <-c(interaction_subsets, interaction_combinations) }# Para cada combinación de interaccionesfor (ints in interaction_subsets) { full_terms <-c(terms, ints)# Crear la fórmula del modelo y almacenarla formula_str <-paste(y, "~", paste(full_terms, collapse ="+")) formulas_list <-append(formulas_list, list(formula_str)) } } }# Eliminar posibles duplicados de fórmulas formulas_list <-unique(formulas_list)# Total de modelos a ajustar total_models <-length(formulas_list)# Iniciar el progreso p <-progressor(steps = total_models)# Ajustar los modelos en paralelo usando foreach results_list <-foreach(i =1:total_models, .packages =c("nnet", "MASS"), .combine ='rbind') %dopar% { formula_str <- formulas_list[[i]] formula <-as.formula(formula_str)# Ajustar el modelo model <-tryCatch( nnet::multinom(formula, data = data, trace =FALSE),error =function(e) NULL,warning =function(w) NULL )# Actualizar el progresop(sprintf("Ajustando modelo %d de %d", i, total_models))# Si el modelo se ajustó correctamente, almacenar los resultadosif (!is.null(model)) { bic <-BIC(model)data.frame(predictors = formula_str,BIC = bic,stringsAsFactors =FALSE ) } else {NULL } }# Convertir los resultados a dataframe y ordenar por BIC results_df <-as.data.frame(results_list) results_df <- results_df %>%arrange(BIC)return(results_df)}num_cores <- parallel::detectCores() -1cl <-makeCluster(num_cores)registerDoParallel(cl)#pacman job kableExtra tidyverse cluster WeightedCluster devtools TraMineR TraMineRextras NbClust haven ggseqplot gridExtra Tmisc factoextra reticulate withr rmarkdown quartooptions(knitr.kable.NA ='')#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:##:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#knitr::knit_hooks$set(time_it =local({ now <-NULLfunction(before, options) {if (before) {# record the current time before each chunk now <<-Sys.time() } else {# calculate the time difference after a chunk res <-ifelse(difftime(Sys.time(), now)>(60^2),difftime(Sys.time(), now)/(60^2),difftime(Sys.time(), now)/(60^1))# return a character string to show the time x<-ifelse(difftime(Sys.time(), now)>(60^2),paste("Tiempo que demora esta sección:", round(res,1), "horas"),paste("Tiempo que demora esta sección:", round(res,1), "minutos"))paste('<div class="message">', gsub('##', '\n', x),'</div>', sep ='\n') } }}))knitr::opts_chunk$set(time_it =TRUE)#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:format_cells <-function(df, rows ,cols, value =c("italics", "bold", "strikethrough")){# select the correct markup# one * for italics, two ** for bold map <-setNames(c("*", "**", "~~"), c("italics", "bold", "strikethrough")) markup <- map[value] for (r in rows){for(c in cols){# Make sure values are not factors df[[c]] <-as.character( df[[c]])# Update formatting df[r, c] <-ifelse(nchar(df[r, c])==0,"",paste0(markup, gsub(" ", "", df[r, c]), markup)) } }return(df)}#To produce line breaks in messages and warningsknitr::knit_hooks$set(error =function(x, options) {paste('\n\n<div class="alert alert-danger">',gsub('##', '\n', gsub('^##\ Error', '**Error**', x)),'</div>', sep ='\n') },warning =function(x, options) {paste('\n\n<div class="alert alert-warning">',gsub('##', '\n', gsub('^##\ Warning:', '**Warning**', x)),'</div>', sep ='\n') },message =function(x, options) {paste('<div class="message">',gsub('##', '\n', x),'</div>', sep ='\n') })#_#_#_#_#_#_#_#_#_#_#_#_#_invisible("Function to format CreateTableOne into a database")as.data.frame.TableOne <-function(x, ...) {capture.output(print(x,showAllLevels =TRUE, varLabels = T,...) -> x) y <-as.data.frame(x) y$characteristic <- dplyr::na_if(rownames(x), "") y <- y %>%fill(characteristic, .direction ="down") %>% dplyr::select(characteristic, everything())rownames(y) <-NULL y}#_#_#_#_#_#_#_#_#_#_#_#_#_# Austin, P. C. (2009). The Relative Ability of Different Propensity # Score Methods to Balance Measured Covariates Between # Treated and Untreated Subjects in Observational Studies. Medical # Decision Making. https://doi.org/10.1177/0272989X09341755smd_bin <-function(x,y){ z <- x*(1-x) t <- y*(1-y) k <-sum(z,t) l <- k/2return((x-y)/sqrt(l))}#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:if(.Platform$OS.type =="windows") withAutoprint({memory.size()memory.size(TRUE)memory.limit()})
import numpy as npimport matplotlib.pyplot as pltfrom sklearn.metrics import pairwise_distancesfrom sklearn.cluster import KMeansimport seaborn as snsfrom matplotlib.patches import Ellipse# Generar datos artificiales bien centradosnp.random.seed(42)cluster_1 = np.random.normal(loc=0, scale=0.5, size=(30, 2))cluster_2 = np.random.normal(loc=5, scale=0.5, size=(30, 2))cluster_3 = np.random.normal(loc=10, scale=0.5, size=(30, 2))data = np.vstack([cluster_1, cluster_2, cluster_3])# Aplicar K-Means con k=3 para obtener las etiquetas (usamos K-Means solo para obtener etiquetas iniciales)kmeans = KMeans(n_clusters=3, random_state=42).fit(data)
C:\Users\andre\AppData\Local\Programs\Python\PYTHON~1\Lib\site-packages\sklearn\cluster\_kmeans.py:1416: FutureWarning: The default value of `n_init` will change from 10 to 'auto' in 1.4. Set the value of `n_init` explicitly to suppress the warning
super()._check_params_vs_input(X, default_n_init=10)
Exception in thread Thread-2 (_readerthread):
Traceback (most recent call last):
File "C:\Users\andre\AppData\Local\Programs\Python\PYTHON~1\Lib\threading.py", line 1038, in _bootstrap_inner
self.run()
File "C:\Users\andre\AppData\Local\Programs\Python\PYTHON~1\Lib\threading.py", line 975, in run
self._target(*self._args, **self._kwargs)
File "C:\Users\andre\AppData\Local\Programs\Python\PYTHON~1\Lib\subprocess.py", line 1597, in _readerthread
buffer.append(fh.read())
^^^^^^^^^
File "<frozen codecs>", line 322, in decode
UnicodeDecodeError: 'utf-8' codec can't decode byte 0xa0 in position 16: invalid start byte
C:\Users\andre\AppData\Local\Programs\Python\PYTHON~1\Lib\site-packages\joblib\externals\loky\backend\context.py:136: UserWarning: Could not find the number of physical cores for the following reason:
found 0 physical cores < 1
Returning the number of logical cores instead. You can silence this warning by setting LOKY_MAX_CPU_COUNT to the number of cores you want to use.
warnings.warn(
File "C:\Users\andre\AppData\Local\Programs\Python\PYTHON~1\Lib\site-packages\joblib\externals\loky\backend\context.py", line 282, in _count_physical_cores
raise ValueError(f"found {cpu_count_physical} physical cores < 1")
Code
labels = kmeans.labels_# Calcular los medoides manualmentemedoids = []for i in np.unique(labels): cluster_points = data[labels == i] distances = pairwise_distances(cluster_points, metric='euclidean') medoid_index = np.argmin(distances.sum(axis=0)) medoids.append(cluster_points[medoid_index])medoids = np.array(medoids)# Crear el gráficoplt.figure(figsize=(8, 6))sns.scatterplot(x=data[:, 0], y=data[:, 1], hue=labels, palette="viridis", style=labels, legend=None)plt.scatter(medoids[:, 0], medoids[:, 1], color='red', s=200, marker='*', label='Medoid')# Añadir las elipses alrededor de cada cluster (simplificadas)for i in np.unique(labels): cluster_points = data[labels == i] mean_x, mean_y = np.mean(cluster_points, axis=0) cov_matrix = np.cov(cluster_points.T) width =2* np.std(cluster_points[:, 0]) height =2* np.std(cluster_points[:, 1]) ellipse = Ellipse((mean_x, mean_y), width, height, edgecolor='black', facecolor='none', linewidth=2, linestyle='--') plt.gca().add_patch(ellipse)plt.title("Clusters con Medoides Destacados y Elipses Simplificadas")plt.xlabel("X")plt.ylabel("Y")plt.legend()# Guardar el gráfico en un archivo PNGplt.savefig("_figs/clusters_kmedoids.png", format="png", dpi=300, bbox_inches='tight')# Mostrar el gráficoplt.show()
invisible("info de validación de modelos con bootstrap")# States_Wide.seq_quarter_t_prim_adm_cens, # group=om_dist_quarter_c$clustering$cluster9, # invisible("Hacemos clasificación de pertenencia cluster y ponemos etiquetas")ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_om9 <-factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM larga duración(3)", "TSM, 1 año después, TSM(5)", "Un evento, comorbilidad(6)", "TSM, 2 años después, TSM(7)", "TSM, 2 años y medio después, TSM(8)", "Ingresa por TSM, después, otras causas constantemente(9)", "TSM, después, TSM constantemente(2)"))
Tiempo que demora esta sección: 0 minutos
Vemos los diagnósticos que vienen después de aquellos cluster con más de un ingreso.
Code
diag_om9_5<-df_filled %>% dplyr::filter(run %in%subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, clus_om9=="TSM, 1 año después, TSM(5)")$run) %>% dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) %>% dplyr::group_by(run) %>% dplyr::filter(row_number() !=1) %>%# Elimina la primera observación de cada run dplyr::mutate(all_diags =paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse =", ") ) %>% dplyr::summarise(all_diags =first(all_diags),fecha_egreso_rec_fmt =first(fecha_egreso_rec_fmt),estab_homo =first(estab_homo) ) %>% dplyr::ungroup() %>% dplyr::pull(all_diags) %>%# Extraer la columna all_diags como vectorstrsplit(split =", ") %>%# Separar cada diagnóstico por comasunlist() # Convertir la lista en un vectorinvisible("head(arrange(data.frame(table(diag_om9_5)),-Freq),20)")invisible("Para chatgpt= estos son códigos de CIE-10, descríbeme brevemente cada uno en markdown en formato 'Cód. CIE-10 (n=Freq) - [descripción] '")## F322 (n=66) - Episodio depresivo grave sin síntomas psicóticos# F329 (n=56) - Episodio depresivo no especificado# F319 (n=48) - Trastorno afectivo bipolar, episodio maníaco, no especificado# F609 (n=48) - Trastorno de la personalidad, no especificado# F603 (n=41) - Trastorno de la personalidad emocionalmente inestable, tipo límite# F209 (n=38) - Esquizofrenia, tipo no especificado# C490 (n=29) - Neoplasia maligna de tejido conjuntivo y otros tejidos blandos de localización no especificada# F192 (n=27) - Trastorno mental y del comportamiento debido al uso de múltiples drogas y consumo de otras sustancias psicodislépticas, dependencia# F200 (n=26) - Esquizofrenia paranoide# G909 (n=21) - Trastorno del sistema nervioso autónomo, no especificado# Z511 (n=20) - Atención de radioterapia# F432 (n=19) - Reacción de estrés agudo# F431 (n=15) - Trastorno de estrés postraumático (TEPT)# Z915 (n=13) - Antecedentes personales de traumatismo no clasificado en otra parte# F608 (n=12) - Otros trastornos de la personalidad específicos# F312 (n=11) - Trastorno afectivo bipolar, episodio hipomaníaco# F316 (n=11) - Trastorno afectivo bipolar, episodio mixto# G409 (n=11) - Epilepsia, no especificada# J304 (n=11) - Rinitis alérgica, no especificada# F202 (n=10) - Esquizofrenia catatónica
Tiempo que demora esta sección: 0 minutos
Quienes ingresan un año después por TSM, el segundo episodio se caracteriza por episodios depresivos, trastornos de la personalidad, esquizofrenia, trastornos mentales y comportamentales por múltiples sustancias, estrés agudo y postraumático, afectivo bipolar, trastorno sistema nervioso autónomo.
Code
diag_om9_7<-df_filled %>% dplyr::filter(run %in%subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, clus_om9=="TSM, 2 años después, TSM(7)")$run) %>% dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) %>% dplyr::group_by(run) %>% dplyr::filter(row_number() !=1) %>%# Elimina la primera observación de cada run dplyr::mutate(all_diags =paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse =", ") ) %>% dplyr::summarise(all_diags =first(all_diags),fecha_egreso_rec_fmt =first(fecha_egreso_rec_fmt),estab_homo =first(estab_homo) ) %>% dplyr::ungroup() %>% dplyr::pull(all_diags) %>%# Extraer la columna all_diags como vectorstrsplit(split =", ") %>%# Separar cada diagnóstico por comasunlist() # Convertir la lista en un vectorinvisible("head(arrange(data.frame(table(diag_om9_7)),-Freq),20)")invisible("Para chatgpt= estos son códigos de CIE-10, descríbeme brevemente cada uno en markdown en formato 'Cód. CIE-10 (n=Freq) - [descripción] '")# F209 (n=28) - Esquizofrenia, tipo no especificado# F329 (n=28) - Episodio depresivo no especificado# F609 (n=28) - Trastorno de la personalidad, no especificado# F319 (n=26) - Trastorno afectivo bipolar, episodio maníaco, no especificado# F603 (n=25) - Trastorno de la personalidad emocionalmente inestable, tipo límite# F322 (n=18) - Episodio depresivo grave sin síntomas psicóticos# F200 (n=16) - Esquizofrenia paranoide# F29X (n=11) - Psicosis no orgánica, no especificada# F192 (n=10) - Trastorno mental y del comportamiento debido al uso de múltiples drogas y consumo de otras sustancias psicodislépticas, dependencia# X610 (n=8) - Autolesión intencional mediante saltar desde un lugar elevado# F312 (n=7) - Trastorno afectivo bipolar, episodio hipomaníaco# F314 (n=7) - Trastorno afectivo bipolar, episodio maníaco con síntomas psicóticos# F239 (n=6) - Trastorno psicótico agudo y transitorio, no especificado# F432 (n=6) - Reacción de estrés agudo# R458 (n=6) - Otros síntomas y signos que involucran el estado emocional# T435 (n=6) - Intoxicación por psicotrópicos no especificados# E669 (n=5) - Obesidad, no especificada# F203 (n=5) - Esquizofrenia hebefrénica# X619 (n=5) - Autolesión intencional, método no especificado# Z922 (n=5) - Antecedentes de abuso de drogas psicotrópicas
Tiempo que demora esta sección: 0 minutos
Quienes ingresan dos años después por TSM, el segundo episodio se caracteriza por esquizofrenia, episodios depresivos, trastornos de la personalidad, afectivo biopolar, psicosis no orgánica, trastorno por consumo de múltiples drogas u otras sustancias psicodslépitcas, autolesión, estrés agudo, intoxicación por psicotrópicos.
Code
diag_om9_8<-df_filled %>% dplyr::filter(run %in%subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, clus_om9=="TSM, 2 años y medio después, TSM(8)")$run) %>% dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) %>% dplyr::group_by(run) %>% dplyr::filter(row_number() !=1) %>%# Elimina la primera observación de cada run dplyr::mutate(all_diags =paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse =", ") ) %>% dplyr::summarise(all_diags =first(all_diags),fecha_egreso_rec_fmt =first(fecha_egreso_rec_fmt),estab_homo =first(estab_homo) ) %>% dplyr::ungroup() %>% dplyr::pull(all_diags) %>%# Extraer la columna all_diags como vectorstrsplit(split =", ") %>%# Separar cada diagnóstico por comasunlist() # Convertir la lista en un vectorinvisible("head(arrange(data.frame(table(diag_om9_8)),-Freq),20)")invisible("Para chatgpt= estos son códigos de CIE-10, descríbeme brevemente cada uno en markdown en formato 'Cód. CIE-10 (n=Freq) - [descripción] '")# F209 (n=29) - Esquizofrenia, tipo no especificado# F319 (n=25) - Trastorno afectivo bipolar, episodio maníaco, no especificado# F322 (n=19) - Episodio depresivo grave sin síntomas psicóticos# F609 (n=19) - Trastorno de la personalidad, no especificado# F192 (n=16) - Trastorno mental y del comportamiento debido al uso de múltiples drogas y consumo de otras sustancias psicodislépticas, dependencia# F200 (n=14) - Esquizofrenia paranoide# G909 (n=8) - Trastorno del sistema nervioso autónomo, no especificado# F29X (n=7) - Psicosis no orgánica, no especificada# F638 (n=7) - Otros trastornos específicos de la personalidad y del comportamiento# F639 (n=7) - Trastorno de la personalidad, no especificado# F431 (n=6) - Trastorno de estrés postraumático (TEPT)# Z720 (n=6) - Problemas relacionados con el estilo de vida# Z915 (n=6) - Antecedentes personales de traumatismo no clasificado en otra parte# E039 (n=5) - Hipotiroidismo, no especificado# F259 (n=5) - Trastorno esquizoafectivo, no especificado# F316 (n=5) - Trastorno afectivo bipolar, episodio mixto# F608 (n=5) - Otros trastornos de la personalidad específicos# T509 (n=5) - Intoxicación por sustancia no especificada# E669 (n=4) - Obesidad, no especificada
Tiempo que demora esta sección: 0 minutos
Quienes ingresan dos años y medio después por TSM, el segundo episodio se caracteriza por esquizofrenia, trastorno bipolar, depresivo y de la personalidad, mental y comportamiento por múltiples drogas, trastorno sistema nervioso autónomo, psicósis no orgánica.
Generamos un gráfico de PPOO por cada conglomerado.
Code
ppoo_clus_pre<- df_filled[,c("run","glosa_pueblo_originario")] %>% dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run", "clus_om9","factor_inclusivo_real_hist_mas_autperc")], by="run", multiple="first") %>% dplyr::mutate(glosa_pueblo_originario_rec= dplyr::case_when(glosa_pueblo_originario=="NINGUNO"& factor_inclusivo_real_hist_mas_autperc!="00"~"DESCONOCIDO", T~glosa_pueblo_originario)) %>% janitor::tabyl(glosa_pueblo_originario_rec, clus_om9) %>% janitor::adorn_percentages("row")reshape2::melt(ppoo_clus_pre, id.vars ="glosa_pueblo_originario_rec") %>% dplyr::mutate(glosa_pueblo_originario_rec= dplyr::recode(glosa_pueblo_originario_rec, "OTRO (ESPECIFICAR)"="OTRO(n=77)", "RAPA NUI (PASCUENSE)"="RAPA NUI(n=34)", "YAGÁN (YÁMANA)"="YAGÁN(n=2)","AYMARA"="AYMARA(n=13)","COLLA"="COLLA(n=6)","DIAGUITA"="DIAGUITA(n=3)","KAWÉSQAR"="KAWÉSQAR(n=4)","MAPUCHE"="MAPUCHE(n=255)","DESCONOCIDO"=".DESCONOCIDO(n=1.985)","NINGUNO"=".NINGUNO(n=9.156)")) %>%#dplyr::filter(glosa_pueblo_originario!="NINGUNO") %>% # dplyr::mutate(variable= # dplyr::recode(variable, "6036_TSM, 1 año después, otras causas"="6036_TSM, 1 año\ndespués, otras causas",# "5710_TSM, 1 año después, TSM"="5710_TSM, 1 año\ndespués, TSM",# "5939_Un evento TSM larga duración"="5939_Un evento TSM\nlarga duración",# "5989_Un evento, comorbilidad"="5989_Un evento,\ncomorbilidad")) %>% ggplot(aes(x = glosa_pueblo_originario_rec, y = value, fill = variable)) +geom_bar(stat ="identity", position ="fill") +scale_fill_manual(values =c("#E27A5B", "#6B8E23", "#D2B48C", "#696969", "#BDB76B", "#4682B4", "#8B4513", "#708090", "#8FBC8F")) +labs(title =NULL,x ="Grupo Étnico",y ="Proporción de Casos",fill ="Grupos") +# Cambia el título de la leyenda a "Grupos"theme_minimal() +theme(axis.text.y =element_text(size =12), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =12), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =14), # Tamaño del título del eje Xaxis.title.y =element_text(size =14), # Tamaño del título del eje Yplot.title =NULL, # Tamaño y estilo del título del gráficolegend.title =element_text(size =14, margin =margin(b =-.1)), # Tamaño del título de la leyendalegend.spacing.y =unit(1.5, "lines"),legend.box.spacing =unit(0.5, "lines"), # Controla el espacio entre la leyenda y el gráficolegend.margin =margin(5, 5, 5, 5), legend.key.height =unit(1, "cm"), legend.text =element_text(size =12) # Tamaño del texto de la leyenda ) +coord_flip() # Hacer el gráfico horizontalggsave("_figs/grafico_ancho_achatado_om9.png", width =10, height =5, dpi=1000)
PPOO por cluster
Tiempo que demora esta sección: 0 minutos
Vemos los gráficos de las trayectorias
Code
categories_om9<-attr(States_Wide.seq_quarter_t_prim_adm_cens, "labels")new_labels <- categories_om9new_labels[which(categories_om9 =="Otras causas")] <-"Otras\ncausas"#new_labels[which(categories == "Consumo\nde sustancias")] <- "Consumo de\nsustancias"seq_plot_om9 <-ggseqiplot(States_Wide.seq_quarter_t_prim_adm_cens, group=factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM\nlarga duración(3)", "TSM, 1 año después,\nTSM(5)", "Un evento,\ncomorbilidad(6)", "TSM, 2 años después,\nTSM(7)", "TSM, 2 años y medio\ndespués, TSM(8)", "Ingresa por TSM, después, otras\ncausas constantemente(9)", "TSM, después, TSM\nconstantemente(2)")), facet_ncol=3, facet_nrow=3) +theme(legend.position ="none")+labs(x="Trimestres", y="# IDs de usuarios")+#guides(fill = guide_legend(nrow = 1))+theme(panel.spacing =unit(0.1, "lines"), # Reduce el espaciado entre los panelesaxis.text.y =element_text(size =15), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =15), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =15), # Tamaño del título del eje Xaxis.title.y =element_text(size =15, margin =margin(r =-10)),#,margin = margin(l = -10)),strip.text =element_text(size =11, margin =margin(b =-15)),legend.text =element_text(size =15),legend.spacing.x =unit(0.1, 'cm'), # Alinea el título de la leyenda hacia la izquierdalegend.box.margin =margin(t =0, r =0, b =0, l =-50),legend.position ="bottom", legend.justification ="left",panel.spacing.y =unit(0.5, "lines"),strip.placement ="outside", # Para colocar las tiras fuera de los ejesstrip.background =element_blank() # Elimina el fondo para que parezca más espacioso#legend.key.size = unit(1.5, "lines"), # Aumenta el tamaño de los símbolos en la leyenda )+guides(fill =guide_legend(nrow =1)) +scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513","#FFFFFF","#808080","#000000"))seq_plot_om9ggsave(filename="_figs/clustershc_om9_mod.png", seq_plot_om9, width =8.5, height =5.5, dpi=1000)
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico.
Tiempo que demora esta sección: 0.3 minutos
Code
seq_plot2_om9 <-ggseqdplot(States_Wide.seq_quarter_t_prim_adm_cens, group=factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM\nlarga duración(3)", "TSM, 1 año después,\nTSM(5)", "Un evento,\ncomorbilidad(6)", "TSM, 2 años después,\nTSM(7)", "TSM, 2 años y medio\ndespués, TSM(8)", "Ingresa por TSM, después, otras\ncausas constantemente(9)", "TSM, después, TSM\nconstantemente(2)")), facet_ncol=3, facet_nrow=3) +theme(legend.position ="none")+# Colocar la leyenda abajolabs(x="Trimestres", y="Frecuencia relativa de estados")+theme(panel.spacing =unit(0.1, "lines"),axis.text.y =element_text(size =15), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =15), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =15), # Tamaño del título del eje Xaxis.title.y =element_text(size =15, margin =margin(r =-5)),strip.text =element_text(size =11),panel.spacing.y =unit(0.5, "lines"),strip.placement ="outside", # Para colocar las tiras fuera de los ejesstrip.background =element_blank() # Elimina el fondo para que parezca más espacioso#legend.key.size = unit(1.5, "lines"), # Aumenta el tamaño de los símbolos en la leyenda ) # Colocar la leyenda abajoseq_plot2_om9ggsave("_figs/clustershc_om92_mod.png",seq_plot2_om9, width =8.5, height =5.5, dpi=1000)table_data <-sprintf("%1.2f",om_dist_quarter_c$stats[8,])table_data <-as.data.frame(t(table_data))colnames(table_data)<-attr(om_dist_quarter_c$stats, "name")table_data %>% knitr::kable()
PBC
HG
HGSD
ASW
ASWw
CH
R2
CHsq
R2sq
HC
0.58
0.78
0.77
0.55
0.55
494.70
0.40
813.10
0.52
0.10
Trayectorias de hospitalización, frecuencia relativa de estados en un gráfico de barras apiladas por trimestre.
Trayectorias de hospitalización, frecuencia relativa de estados en un gráfico de barras apiladas por trimestre.
Tiempo que demora esta sección: 0.1 minutos
De este modo, presenta el cambio agregado en la distribución de estados a lo largo del tiempo, sin considerar las secuencias individuales.
1.1.1.Exploración transiciones
1.1.1.a Transiciones- RM y no RM
Tasas de transición no RM a RM y viceversa
Code
invisible("Tasas de transición no RM a RM y viceversa")trim_tasa_hc_clus9_cens_cnt<-seqcount_t(States_Wide.seq_quarter_t_prim_adm_RM_cens, group=factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM\nlarga duración(3)", "TSM, 1 año después,\nTSM(5)", "Un evento,\ncomorbilidad(6)", "TSM, 2 años después,\nTSM(7)", "TSM, 2 años y medio\ndespués, TSM(8)", "Ingresa por TSM, después, otras\ncausas constantemente(9)", "TSM, después, TSM\nconstantemente(2)"))) %>% dplyr::filter(count>0) %>% dplyr::mutate(trans =paste0(from,"_", to)) %>% dplyr::mutate(across(c("from","to"),~gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) trim_tasa_hc_clus9_cens_rate<-seqtrate_t(States_Wide.seq_quarter_t_prim_adm_RM_cens, group=factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM\nlarga duración(3)", "TSM, 1 año después,\nTSM(5)", "Un evento,\ncomorbilidad(6)", "TSM, 2 años después,\nTSM(7)", "TSM, 2 años y medio\ndespués, TSM(8)", "Ingresa por TSM, después, otras\ncausas constantemente(9)", "TSM, después, TSM\nconstantemente(2)"))) %>% dplyr::filter(rate>0) %>% dplyr::mutate(trans =paste0(from,"_", to)) %>% dplyr::mutate(across(c("from","to"),~gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))
Tiempo que demora esta sección: 0 minutos
Code
trim_tasa_hc_clus9_cens_rate %>% dplyr::left_join(trim_tasa_hc_clus9_cens_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% dplyr::rename("recuento"="count") %>% dplyr::filter(from %in%c("RM", "noRM")) %>%ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +geom_tile() +coord_flip()+scale_fill_gradient(low ="white", high ="blue") +# Ajusta la escala de colores según tus preferenciaslabs(title ="Tasas de transición, Trimestre (s/censura)",x ="Desde",y ="Hacia",fill ="Rate") +theme_minimal() +facet_wrap(~glosa_sexo)+theme(axis.text.x =element_text(angle =45, hjust =1))+geom_text(aes(label =sprintf("%1.2f", rate), size =log(recuento+1)*.5), color ="black")invisible("Hay muy pocos casos que se entrecruzan entre noRM y RM (fuera de la diagnonal)")
Porcentajes de transición no-RM y RM por cada cluster
Tiempo que demora esta sección: 0.1 minutos
Hay muy pocos casos que se entrecruzan entre noRM y RM (fuera de la diagnonal)
1.1.1.b Transiciones
Code
trim_tasa2_hc_clus9_cens_cnt<-seqcount_t(States_Wide.seq_quarter_t_prim_adm_cens, group=factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM\nlarga duración(3)", "TSM, 1 año después,\nTSM(5)", "Un evento,\ncomorbilidad(6)", "TSM, 2 años después,\nTSM(7)", "TSM, 2 años y medio\ndespués, TSM(8)", "Ingresa por TSM, después, otras\ncausas constantemente(9)", "TSM, después, TSM\nconstantemente(2)"))) %>% dplyr::filter(count>0) %>% dplyr::mutate(trans =paste0(from,"_", to)) %>% dplyr::mutate(across(c("from","to"),~gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) trim_tasa2_hc_clus9_cens_rate<-seqtrate_t(States_Wide.seq_quarter_t_prim_adm_cens, group=factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM\nlarga duración(3)", "TSM, 1 año después,\nTSM(5)", "Un evento,\ncomorbilidad(6)", "TSM, 2 años después,\nTSM(7)", "TSM, 2 años y medio\ndespués, TSM(8)", "Ingresa por TSM, después, otras\ncausas constantemente(9)", "TSM, después, TSM\nconstantemente(2)"))) %>% dplyr::filter(rate>0) %>% dplyr::mutate(trans =paste0(from,"_", to)) %>% dplyr::mutate(across(c("from","to"),~gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))
Tiempo que demora esta sección: 0 minutos
Code
trim_tasa2_hc_clus9_cens_rate %>% dplyr::left_join(trim_tasa2_hc_clus9_cens_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% dplyr::rename("recuento"="count") %>%#dplyr::filter(from %in% c("RM", "noRM")) %>% ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +geom_tile() +coord_flip()+scale_fill_gradient(low ="white", high ="blue") +# Ajusta la escala de colores según tus preferenciaslabs(title ="Tasas de transición, Trimestre (s/censura)",x ="Desde",y ="Hacia",fill ="Rate") +theme_minimal() +facet_wrap(~glosa_sexo)+theme(axis.text.x =element_text(angle =45, hjust =1))+geom_text(aes(label =sprintf("%1.2f", rate), size =log(recuento+1)*.5), color ="black")
Porcentajes de transición no-RM y RM por cada cluster
Tiempo que demora esta sección: 0.1 minutos
1.1.1.c Tiempo promedio por cluster
Code
seq_mean_t(States_Wide.seq_quarter_t_prim_adm_cens, group=factor(om_dist_quarter_c$clustering$cluster9,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster9)), "name")),labels=c("Un evento, TSM(1)", "Un evento, TUS(4)", "Un evento TSM\nlarga duración(3)", "TSM, 1 año después,\nTSM(5)", "Un evento,\ncomorbilidad(6)", "TSM, 2 años después,\nTSM(7)", "TSM, 2 años y medio\ndespués, TSM(8)", "Ingresa por TSM, después, otras\ncausas constantemente(9)", "TSM, después, TSM\nconstantemente(2)"))) %>% data.table::as.data.table(keep.rowname=T) %>%ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+geom_bar(width =1, stat ="identity") +theme_minimal() +labs(title =NULL,x =NULL,y =NULL) +coord_flip()+theme(#axis.text.x = element_blank(),#axis.text.y = element_blank(),panel.grid =element_blank()) +# scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +geom_text(aes(label =round(Mean,1)), position =position_stack(vjust =0.5), size =2.5, # Ajusta el tamaño de la fuente aquícolor ="black", # Color del textofamily ="sans", # Puedes cambiar la fuente si lo deseasbackground =element_rect(fill ="white", color =NA)) +# Fondo blancotheme(legend.title =element_blank())invisible("No me aporta mucho")# seq_mean_t_dos_grupos(States_Wide.seq_quarter_t_prim_adm_cens, group1=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam, group2=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc)
Tiempo promedio en cada estado por estatus PPOO (Trimestral c/censura)
Tiempo que demora esta sección: 0.1 minutos
1.1.3. Comparación variables
1.1.3.a. Comparación covariables- PPOO
Code
# round(# prop.table(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_om9, # ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc),1),# 2)ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>%count(clus_om9, factor_inclusivo_real_hist_mas_autperc) %>%group_by(clus_om9) %>%mutate(prop = scales::percent(n /sum(n))) %>%select(-n) %>%pivot_wider(names_from = factor_inclusivo_real_hist_mas_autperc, values_from = prop, values_fill ="0") %>% knitr::kable("markdown", col.names=c("Conglomerados","No se identifica/no pertenece", "No se identifica/hay reconocimiento", "Se identifica/hay reconocimeinto"), caption="Porcentajes por fila, conglomerado vs. Pertenencia/identificación + Reconocimento CONADI PPOO")# 00 10 11# 6035 0.81 0.11 0.08# 6025 0.79 0.12 0.10# 5939 0.83 0.11 0.07# 5989 0.84 0.09 0.08# 6036 0.80 0.11 0.09# 5710 0.79 0.12 0.09invisible("6025 tiwnw un poxo mas PPOO, lo mismo con 5710")
Porcentajes por fila, conglomerado vs. Pertenencia/identificación + Reconocimento CONADI PPOO
Conglomerados
No se identifica/no pertenece
No se identifica/hay reconocimiento
Se identifica/hay reconocimeinto
Un evento, TSM(1)
80.7%
11.1%
8.2%
Un evento, TUS(4)
78.5%
11.5%
10.0%
Un evento TSM larga duración(3)
78.0%
12.5%
9.5%
TSM, 1 año después, TSM(5)
80.5%
10.6%
8.8%
Un evento, comorbilidad(6)
84.2%
8.6%
7.2%
TSM, 2 años después, TSM(7)
85.5%
10.3%
4.1%
TSM, 2 años y medio después, TSM(8)
85.2%
8.6%
6.2%
Ingresa por TSM, después, otras causas constantemente(9)
69%
25%
6%
TSM, después, TSM constantemente(2)
73%
13%
13%
Tiempo que demora esta sección: 0 minutos
Vemos las categorías de clasificación de PPOO según autopercepción (en MINSAL y en RSH) y reconocimiento CONADI.
Pearson's Chi-squared test
data: .
X-squared = 14.742, df = 16, p-value = 0.5436
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.4871
alternative hypothesis: two.sided
round(prop.table(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_om9, ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc_bin),1),2) %>% knitr::kable("markdown", col.names=c("Conglomerados","No se identifica/no pertenece", "Se identifica/pertenece"), caption="Porcentajes por fila, conglomerado vs. Pertenencia/identificación PPOO")
Porcentajes por fila, conglomerado vs. Pertenencia/identificación PPOO
Conglomerados
No se identifica/no pertenece
Se identifica/pertenece
Un evento, TSM(1)
0.81
0.19
Un evento, TUS(4)
0.78
0.22
Un evento TSM larga duración(3)
0.78
0.22
TSM, 1 año después, TSM(5)
0.81
0.19
Un evento, comorbilidad(6)
0.84
0.16
TSM, 2 años después, TSM(7)
0.86
0.14
TSM, 2 años y medio después, TSM(8)
0.85
0.15
Ingresa por TSM, después, otras causas constantemente(9)
0.69
0.31
TSM, después, TSM constantemente(2)
0.73
0.27
Tiempo que demora esta sección: 0 minutos
Hicimos una prueba post-hoc usando Bonferroni
Code
# # Beasley, T. M., & Schumacker, R. E. (1995). Multiple Regression Approach to Analyzing Contingency# Tables: Post Hoc and Planned Comparison Procedures. The Journal of Experimental Education, 64(1), 79–93. https://doi.org/10.1080/00220973.1995.9943797chisq.posthoc.test(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_om9, ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc_bin), method ="bonferroni") %>%pivot_longer(cols =c(`0`, `1`), names_to ="Group", values_to ="Values") %>%pivot_wider(names_from = Value, values_from = Values) %>%#separate(Dimension, into = c("Code", "Evento"), sep = "_", extra = "merge") %>% dplyr::filter(Group==1) %>% dplyr::mutate(Residuals=sprintf("%1.2f", Residuals)) %>%select(Dimension, Residuals, `p values`) %>% knitr::kable("markdown", col.names=c("Código-Descripción", "Residuos", "Sig."), caption="Post-hoc, conglomerado vs. Pertenencia/identificación PPOO")
Post-hoc, conglomerado vs. Pertenencia/identificación PPOO
Código-Descripción
Residuos
Sig.
Un evento, TSM(1)
-0.49
1
Un evento, TUS(4)
1.45
1
Un evento TSM larga duración(3)
1.20
1
TSM, 1 año después, TSM(5)
0.00
1
Un evento, comorbilidad(6)
-1.36
1
TSM, 2 años después, TSM(7)
-1.53
1
TSM, 2 años y medio después, TSM(8)
-1.06
1
Ingresa por TSM, después, otras causas constantemente(9)
1.19
1
TSM, después, TSM constantemente(2)
0.71
1
Tiempo que demora esta sección: 0 minutos
1.1.3.b. Comparación covariables- Mortalidad
Code
# invisible("No hay nada, el tiempo promedio de censura es similar")ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% janitor::tabyl(clus_om9,death_time_rec) %>% janitor::adorn_percentages("row")%>% dplyr::mutate(`1`=scales::percent(`1`, accuracy=.1)) %>% dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::group_by(clus_om9) %>% dplyr::summarise(mean=sprintf("%1.1f",mean(cens_time))), by="clus_om9") %>% dplyr::select(-`0`) %>% knitr::kable("markdown", col.names=c("Conglomerado","Mortalidad observada", "Promedio"), caption="Post-hoc, conglomerado vs. Mortalidad y tiempo a censura")
Post-hoc, conglomerado vs. Mortalidad y tiempo a censura
Conglomerado
Mortalidad observada
Promedio
Un evento, TSM(1)
0.8%
17.9
Un evento, TUS(4)
1.8%
18.2
Un evento TSM larga duración(3)
2.4%
17.9
TSM, 1 año después, TSM(5)
1.3%
18.0
Un evento, comorbilidad(6)
1.9%
18.1
TSM, 2 años después, TSM(7)
2.8%
17.9
TSM, 2 años y medio después, TSM(8)
0.0%
18.2
Ingresa por TSM, después, otras causas constantemente(9)
18.8%
18.2
TSM, después, TSM constantemente(2)
6.7%
18.2
Tiempo que demora esta sección: 0 minutos
Code
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% janitor::tabyl(death_time_rec,clus_om9) %>% janitor::chisq.test(correct=T)#X-squared = 64.113, df = 8, p-value = 7.225e-11ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% janitor::tabyl(death_time_rec,clus_om9) %>% janitor::fisher.test(simulate.p.value=T, B=1e5)#p-value = 4e-05invisible("no se basa en la distribución chi-cuadrado. Fisher se basa en permutaciones exactas, por lo que no se calculan df.")invisible("Podría haber algo aquí, aunque son números pequeños")invisible("6036 (morbilidad y a los 4 meses otras causas) y 6035 (sólo un evento por trno.SM) tienen un 1% de gente que muere antes")invisible("5939 (dos semestres continuos por morbilidad psiquiátrica) en cambio, tiene 2.2%")#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_##_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_tabla_cluster_mortalidad_om9<- ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1))chisq.posthoc.test(table(tabla_cluster_mortalidad_om9$clus_om9, tabla_cluster_mortalidad_om9$death_time_rec))%>%pivot_longer(cols =c(`0`, `1`), names_to ="Group", values_to ="Values") %>%pivot_wider(names_from = Value, values_from = Values) %>%#separate(Dimension, into = c("Code", "Evento"), sep = "_", extra = "merge") %>% dplyr::filter(Group==1) %>% dplyr::mutate(Residuals=sprintf("%1.2f", as.numeric(Residuals))) %>%select(Dimension, Residuals, `p values`) %>% knitr::kable("markdown", col.names=c("Código-Descripción", "Residuos", "Sig."), caption="Post-hoc, conglomerado vs. mortalidad")
Pearson's Chi-squared test
data: .
X-squared = 64.113, df = 8, p-value = 7.225e-11
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 2e-05
alternative hypothesis: two.sided
Post-hoc, conglomerado vs. mortalidad
Código-Descripción
Residuos
Sig.
Un evento, TSM(1)
-4.10
7e-04*
Un evento, TUS(4)
1.58
1
Un evento TSM larga duración(3)
2.24
0.4566
TSM, 1 año después, TSM(5)
0.24
1
Un evento, comorbilidad(6)
1.04
1
TSM, 2 años después, TSM(7)
1.82
1
TSM, 2 años y medio después, TSM(8)
-0.98
1
Ingresa por TSM, después, otras causas constantemente(9)
Ingresa por TSM, después, otras causas constantemente(9)
0.82
1.000
TSM, después, TSM constantemente(2)
-1.50
1.000
Tiempo que demora esta sección: 0 minutos
1.1.3.e. Comparación covariables- Región
Code
tabla_cluster_region_om9<-ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], by =c("estab_homo_base"="ESTAB_HOMO"), multiple ="first") %>% janitor::tabyl(codigo_region, clus_om9) %>% janitor::adorn_percentages("col") %>% janitor::adorn_rounding(digits =2)colnames(tabla_cluster_region_om9)<-c("reg", "c1", "c4", "c3", "c5", "c6", "c7", "c8", "c9", "c2")cod_reg_homo_om9<-data.frame(codigo_region =1:16,nombre_region =c("Región de Tarapacá","Región de Antofagasta","Región de Atacama","Región de Coquimbo","Región de Valparaíso","Región del Libertador General Bernardo O'Higgins","Región del Maule","Región del Biobío","Región de La Araucanía","Región de Los Lagos","Región de Aysén del General Carlos Ibáñez del Campo","Región de Magallanes y de la Antártica Chilena","Región Metropolitana de Santiago","Región de Los Ríos","Región de Arica y Parinacota","Región de Ñuble" ),stringsAsFactors =FALSE)dplyr::mutate(tabla_cluster_region_om9, promedio_fila =rowMeans(across(2:10))) %>% dplyr::arrange(desc(promedio_fila)) %>% dplyr::left_join(cod_reg_homo_om9, by=c("reg"="codigo_region")) %>% dplyr::select(reg, nombre_region, everything()) %>% dplyr::select(-promedio_fila) %>% dplyr::mutate_at(3:11,~scales::percent(.)) %>% knitr::kable(caption="Porcentaje por comunas")
Porcentaje por comunas
reg
nombre_region
c1
c4
c3
c5
c6
c7
c8
c9
c2
13
Región Metropolitana de Santiago
45%
35%
48%
51%
57%
43%
35%
44%
27%
5
Región de Valparaíso
9%
13%
10%
5%
6%
10%
11%
6%
27%
10
Región de Los Lagos
6%
20%
5%
4%
10%
6%
12%
6%
0%
8
Región del Biobío
10%
9%
9%
9%
9%
10%
5%
0%
7%
12
Región de Magallanes y de la Antártica Chilena
1%
2%
3%
1%
1%
2%
2%
19%
7%
9
Región de La Araucanía
5%
4%
6%
8%
4%
6%
4%
0%
0%
16
Región de Ñuble
2%
2%
2%
3%
1%
2%
5%
12%
7%
1
Región de Tarapacá
3%
1%
1%
2%
1%
1%
4%
6%
13%
6
Región del Libertador General Bernardo O’Higgins
4%
3%
4%
1%
2%
2%
9%
0%
7%
7
Región del Maule
4%
3%
3%
4%
4%
5%
2%
6%
0%
2
Región de Antofagasta
2%
1%
2%
3%
1%
3%
4%
0%
0%
11
Región de Aysén del General Carlos Ibáñez del Campo
Warning in chisq.test(x, …): Chi-squared approximation may be incorrect
Comparación post-hoc, conglomerado-región
Dimension
Value
Un evento, TSM(1)
Un evento, TUS(4)
Un evento TSM larga duración(3)
TSM, 1 año después, TSM(5)
Un evento, comorbilidad(6)
TSM, 2 años después, TSM(7)
TSM, 2 años y medio después, TSM(8)
Ingresa por TSM, después, otras causas constantemente(9)
TSM, después, TSM constantemente(2)
1
Residuals
2.258
-1.772
-1.702
-0.529
-0.837
-0.739
0.860
1.063
2.867
1
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
0.597
2
Residuals
1.394
-2.272
0.243
0.873
-1.285
0.416
0.886
-0.608
-0.589
2
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
3
Residuals
0.962
-0.478
0.445
0.286
-1.840
-0.159
-0.225
-0.501
-0.485
3
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
4
Residuals
1.415
-0.973
-0.019
-1.483
-1.424
0.575
1.457
-0.388
-0.375
4
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
5
Residuals
-1.829
3.623
0.748
-2.189
-1.651
0.304
0.688
-0.378
2.408
5
p values
1.000
0.042
1.000
1.000
1.000
1.000
1.000
1.000
1.000
6
Residuals
1.147
-0.471
0.416
-1.847
-1.308
-0.981
2.485
-0.770
0.650
6
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
7
Residuals
1.570
-1.679
-0.886
0.339
-0.123
0.521
-0.705
0.462
-0.791
7
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
8
Residuals
1.699
-1.176
-0.213
-0.272
-0.361
0.214
-1.487
-1.322
-0.411
8
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
9
Residuals
-0.488
-1.173
0.672
2.648
-0.298
0.844
-0.441
-0.893
-0.865
9
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
10
Residuals
-7.042
12.357
-2.006
-2.427
0.980
-0.718
1.543
-0.229
-1.127
10
p values
0.000
0.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
11
Residuals
-1.000
0.810
-1.393
0.286
0.974
2.530
-0.471
-0.565
-0.547
11
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
12
Residuals
-2.215
0.262
2.367
-0.226
-0.664
0.562
0.715
5.669
1.642
12
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
0.000
1.000
13
Residuals
1.011
-4.945
1.509
2.172
3.748
-0.375
-1.773
-0.043
-1.376
13
p values
1.000
0.000
1.000
1.000
0.026
1.000
1.000
1.000
1.000
14
Residuals
1.007
0.669
-0.501
0.514
-1.943
-1.447
-0.056
-0.650
-0.629
14
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
15
Residuals
3.842
-2.839
-0.980
-1.392
-1.295
-0.190
-1.146
-0.506
1.587
15
p values
0.018
0.652
1.000
1.000
1.000
1.000
1.000
1.000
1.000
16
Residuals
-0.288
-0.105
-0.924
0.852
-0.824
-0.164
1.624
2.752
1.145
16
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
0.853
1.000
Tiempo que demora esta sección: 0 minutos
Por macrozona
Code
tabla_cluster_macrozona_om9<-ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], by =c("estab_homo_base"="ESTAB_HOMO"), multiple ="first") %>%dplyr::mutate(macrozona = dplyr::case_when( codigo_region %in%c(15, 1, 2, 3) ~"Macrozona Norte", codigo_region %in%c(4, 5)~"Macrozona Centro", codigo_region %in%c(6, 7, 16, 8) ~"Macrozona Centro Sur", codigo_region %in%c(9, 14, 10) ~"Macrozona Sur", codigo_region %in%c(11, 12) ~"Macrozona Austral",TRUE~"RM"# En caso de que algún código no esté especificado)) %>% janitor::tabyl(macrozona, clus_om9) janitor::chisq.test(tabla_cluster_macrozona_om9)#X-squared = 173.09, df = 40, p-value < 2.2e-16janitor::fisher.test(tabla_cluster_macrozona_om9, simulate.p.value=T, B=1e5)#p-value = 1e-05tabla_cluster_macrozona_om9%>% janitor::adorn_percentages("col") %>% janitor::adorn_rounding(digits =2) %>% dplyr::mutate_at(2:10,~scales::percent(.)) %>% knitr::kable(caption="Porcentajes por columna, conglomerado vs. macrozona")
Pearson's Chi-squared test
data: tabla_cluster_macrozona_om9
X-squared = 173.09, df = 40, p-value < 2.2e-16
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: tabla_cluster_macrozona_om9
p-value = 1e-05
alternative hypothesis: two.sided
Porcentajes por columna, conglomerado vs. macrozona
macrozona
Un evento, TSM(1)
Un evento, TUS(4)
Un evento TSM larga duración(3)
TSM, 1 año después, TSM(5)
Un evento, comorbilidad(6)
TSM, 2 años después, TSM(7)
TSM, 2 años y medio después, TSM(8)
Ingresa por TSM, después, otras causas constantemente(9)
TSM, después, TSM constantemente(2)
Macrozona Austral
3%
4%
4%
4%
4%
7%
4%
19%
7%
Macrozona Centro
10%
13%
11%
5%
6%
11%
14%
6%
27%
Macrozona Centro Sur
20%
17%
18%
18%
16%
19%
21%
19%
20%
Macrozona Norte
9%
4%
6%
7%
3%
7%
9%
6%
20%
Macrozona Sur
14%
27%
13%
15%
14%
13%
19%
6%
0%
RM
45%
35%
48%
51%
57%
43%
35%
44%
27%
Tiempo que demora esta sección: 0 minutos
Code
#p-value = 1e-05tab_clus_macrozona_om9<-ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], by =c("estab_homo_base"="ESTAB_HOMO"), multiple ="first") %>%dplyr::mutate(macrozona = dplyr::case_when( codigo_region %in%c(15, 1, 2, 3) ~"Macrozona Norte", codigo_region %in%c(4, 5)~"Macrozona Centro", codigo_region %in%c(6, 7, 16, 8) ~"Macrozona Centro Sur", codigo_region %in%c(9, 14, 10) ~"Macrozona Sur", codigo_region %in%c(11, 12) ~"Macrozona Austral",TRUE~"RM"# En caso de que algún código no esté especificado)) %>% janitor::tabyl(macrozona, clus_om9)pre_tab_clus_macrozona_om9<-ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], by =c("estab_homo_base"="ESTAB_HOMO"), multiple ="first") %>%dplyr::mutate(macrozona = dplyr::case_when( codigo_region %in%c(15, 1, 2, 3) ~"Macrozona Norte", codigo_region %in%c(4, 5)~"Macrozona Centro", codigo_region %in%c(6, 7, 16, 8) ~"Macrozona Centro Sur", codigo_region %in%c(9, 14, 10) ~"Macrozona Sur", codigo_region %in%c(11, 12) ~"Macrozona Austral",TRUE~"RM"# En caso de que algún código no esté especificado))chisq.posthoc.test(tab_clus_macrozona_om9[-1]) %>% dplyr::mutate_at(3:11, ~round(as.numeric(gsub("\\*","",.)),3)) %>%#knitr::kable("html", caption="Comparación post-hoc, conglomerado-región")%>%group_by(Dimension) %>%summarise(across(starts_with("Un evento") |starts_with("TSM") |starts_with("Ingresa"), ~paste0(first(sprintf("%1.2f",.)), " (p=", last(sprintf("%1.3f",.)), ")"))) %>% dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=0.000)","p<0.001)",.)) %>%#dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=1)","p=1.000)",.)) %>% dplyr::mutate(Dimension= tab_clus_macrozona_om9[1]) %>% knitr::kable("markdown", caption="Comparación post-hoc, conglomerado-región")
Comparación post-hoc, conglomerado-región
Dimension
Un evento, TSM(1)
Un evento, TUS(4)
Un evento TSM larga duración(3)
Un evento, comorbilidad(6)
TSM, 1 año después, TSM(5)
TSM, 2 años después, TSM(7)
TSM, 2 años y medio después, TSM(8)
TSM, después, TSM constantemente(2)
Ingresa por TSM, después, otras causas constantemente(9)
Macrozona Austral
-2.23 (p=1.000)
0.79 (p=1.000)
0.52 (p=1.000)
0.29 (p=1.000)
0.07 (p=1.000)
2.29 (p=1.000)
0.12 (p=1.000)
0.68 (p=1.000)
3.35 (p=0.044)
Macrozona Centro
-1.29 (p=1.000)
3.15 (p=0.087)
0.71 (p=1.000)
-2.04 (p=1.000)
-2.57 (p=0.548)
0.48 (p=1.000)
1.13 (p=1.000)
2.18 (p=1.000)
-0.49 (p=1.000)
Macrozona Centro Sur
2.47 (p=0.722)
-1.97 (p=1.000)
-0.75 (p=1.000)
-1.25 (p=1.000)
-0.58 (p=1.000)
-0.10 (p=1.000)
0.31 (p=1.000)
0.04 (p=1.000)
-0.09 (p=1.000)
Macrozona Norte
4.29 (p=0.001)
-3.81 (p=0.007)
-1.07 (p=1.000)
-2.65 (p=0.440)
-0.33 (p=1.000)
-0.35 (p=1.000)
0.34 (p=1.000)
1.80 (p=1.000)
-0.21 (p=1.000)
Macrozona Sur
-5.12 (p<0.001)
8.85 (p<0.001)
-1.32 (p=1.000)
-0.30 (p=1.000)
-0.02 (p=1.000)
-0.68 (p=1.000)
0.87 (p=1.000)
-1.64 (p=1.000)
-0.99 (p=1.000)
RM
1.01 (p=1.000)
-4.95 (p<0.001)
1.51 (p=1.000)
3.75 (p=0.010)
2.17 (p=1.000)
-0.38 (p=1.000)
-1.77 (p=1.000)
-1.38 (p=1.000)
-0.04 (p=1.000)
Tiempo que demora esta sección: 0 minutos
Code
PT = rcompanion::pairwiseNominalIndependence( table(pre_tab_clus_macrozona_om9$clus_om9,pre_tab_clus_macrozona_om9$macrozona),fisher =TRUE,gtest =FALSE,chisq =FALSE,digits =3, simulate.p.value=T,B=1e4)PTrcompanion::cldList(comparison = PT$Comparison,p.value = PT$p.adj.Fisher,threshold =0.05)#Groups sharing a letter are not significantlt different (alpha = 0.05)
Comparison
1 Un evento, TSM(1) : Un evento, TUS(4)
2 Un evento, TSM(1) : Un evento TSM larga duración(3)
3 Un evento, TSM(1) : TSM, 1 año después, TSM(5)
4 Un evento, TSM(1) : Un evento, comorbilidad(6)
5 Un evento, TSM(1) : TSM, 2 años después, TSM(7)
6 Un evento, TSM(1) : TSM, 2 años y medio después, TSM(8)
7 Un evento, TSM(1) : Ingresa por TSM, después, otras causas constantemente(9)
8 Un evento, TSM(1) : TSM, después, TSM constantemente(2)
9 Un evento, TUS(4) : Un evento TSM larga duración(3)
10 Un evento, TUS(4) : TSM, 1 año después, TSM(5)
11 Un evento, TUS(4) : Un evento, comorbilidad(6)
12 Un evento, TUS(4) : TSM, 2 años después, TSM(7)
13 Un evento, TUS(4) : TSM, 2 años y medio después, TSM(8)
14 Un evento, TUS(4) : Ingresa por TSM, después, otras causas constantemente(9)
15 Un evento, TUS(4) : TSM, después, TSM constantemente(2)
16 Un evento TSM larga duración(3) : TSM, 1 año después, TSM(5)
17 Un evento TSM larga duración(3) : Un evento, comorbilidad(6)
18 Un evento TSM larga duración(3) : TSM, 2 años después, TSM(7)
19 Un evento TSM larga duración(3) : TSM, 2 años y medio después, TSM(8)
20 Un evento TSM larga duración(3) : Ingresa por TSM, después, otras causas constantemente(9)
21 Un evento TSM larga duración(3) : TSM, después, TSM constantemente(2)
22 TSM, 1 año después, TSM(5) : Un evento, comorbilidad(6)
23 TSM, 1 año después, TSM(5) : TSM, 2 años después, TSM(7)
24 TSM, 1 año después, TSM(5) : TSM, 2 años y medio después, TSM(8)
25 TSM, 1 año después, TSM(5) : Ingresa por TSM, después, otras causas constantemente(9)
26 TSM, 1 año después, TSM(5) : TSM, después, TSM constantemente(2)
27 Un evento, comorbilidad(6) : TSM, 2 años después, TSM(7)
28 Un evento, comorbilidad(6) : TSM, 2 años y medio después, TSM(8)
29 Un evento, comorbilidad(6) : Ingresa por TSM, después, otras causas constantemente(9)
30 Un evento, comorbilidad(6) : TSM, después, TSM constantemente(2)
31 TSM, 2 años después, TSM(7) : TSM, 2 años y medio después, TSM(8)
32 TSM, 2 años después, TSM(7) : Ingresa por TSM, después, otras causas constantemente(9)
33 TSM, 2 años después, TSM(7) : TSM, después, TSM constantemente(2)
34 TSM, 2 años y medio después, TSM(8) : Ingresa por TSM, después, otras causas constantemente(9)
35 TSM, 2 años y medio después, TSM(8) : TSM, después, TSM constantemente(2)
36 Ingresa por TSM, después, otras causas constantemente(9) : TSM, después, TSM constantemente(2)
p.Fisher p.adj.Fisher
1 0.0001 0.00090
2 0.3450 0.41400
3 0.0973 0.19900
4 0.0011 0.00660
5 0.2740 0.36400
6 0.3760 0.42300
7 0.1120 0.20200
8 0.0295 0.08850
9 0.0001 0.00090
10 0.0001 0.00090
11 0.0001 0.00090
12 0.0046 0.01880
13 0.2930 0.36400
14 0.0470 0.12100
15 0.0053 0.01910
16 0.2000 0.30000
17 0.1020 0.19900
18 0.7380 0.73800
19 0.2840 0.36400
20 0.2460 0.35400
21 0.0292 0.08850
22 0.4300 0.46900
23 0.1470 0.25200
24 0.0563 0.13500
25 0.1690 0.26900
26 0.0039 0.01880
27 0.0380 0.10500
28 0.0047 0.01880
29 0.1050 0.19900
30 0.0007 0.00504
31 0.6450 0.68300
32 0.6980 0.71800
33 0.1000 0.19900
34 0.2830 0.36400
35 0.1720 0.26900
36 0.3740 0.42300
Group Letter MonoLetter
1 Unevento,TSM(1) ab ab
2 Unevento,TUS(4) c c
3 UneventoTSMlargaduración(3) abd ab d
4 TSM,1añodespués,TSM(5) ad a d
5 Unevento,comorbilidad(6) d d
6 TSM,2añosdespués,TSM(7) abd ab d
7 TSM,2añosymediodespués,TSM(8) abc abc
8 IngresaporTSM,después,otrascausasconstantemente(9) abcd abcd
9 TSM,después,TSMconstantemente(2) b b
Edad promedio primer ingreso con intervalo de confianza por conglomerado
Tiempo que demora esta sección: 0.1 minutos
Code
invisible("Prueba de Levene par igualdad de varianzas")with(dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>% dplyr::filter(quarter ==0) %>% dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_om9")], by="run"), car::leveneTest(min_edad_anos, clus_om9))anova_om9 <-oneway.test(min_edad_anos ~ clus_om9, data = dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>% dplyr::filter(quarter ==0) %>% dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_om9")], by="run"),var.equal = T)# Ver los resultados del ANOVAprint(anova_om9)#F = 19.882, num df = 8, denom df = 6029, p-value < 2.2e-16
Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 8 1.3965 0.1924
6029
One-way analysis of means
data: min_edad_anos and clus_om9
F = 19.882, num df = 8, denom df = 6029, p-value < 2.2e-16
Pearson's Chi-squared test
data: .
X-squared = 55.738, df = 32, p-value = 0.00579
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.0032
alternative hypothesis: two.sided
Porcentajes por columna, conglomerado vs. Beneficios
clus_om9
FFAA
FONASA A
FONASA BC
FONASA D
ISAPRE
Un evento, TSM(1)
4.3%
26.8%
32.1%
11.70%
25.1%
Un evento, TUS(4)
1.9%
28.2%
31.9%
14.50%
23.6%
Un evento TSM larga duración(3)
4.0%
29.1%
32.1%
9.50%
25.4%
TSM, 1 año después, TSM(5)
3.5%
26.5%
31.4%
8.40%
30.1%
Un evento, comorbilidad(6)
1.4%
27.3%
38.8%
12.40%
20.1%
TSM, 2 años después, TSM(7)
3.4%
15.2%
37.2%
15.90%
28.3%
TSM, 2 años y medio después, TSM(8)
1.2%
23.5%
39.5%
14.80%
21.0%
Ingresa por TSM, después, otras causas constantemente(9)
Warning in stats::chisq.test(., …): Chi-squared approximation may be incorrect
Pearson's Chi-squared test
data: .
X-squared = 17.51, df = 8, p-value = 0.02521
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.01968
alternative hypothesis: two.sided
Warning in stats::chisq.test(., …): Chi-squared approximation may be incorrect
Pearson's Chi-squared test
data: .
X-squared = 14.445, df = 8, p-value = 0.07088
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.05762
alternative hypothesis: two.sided
Ingresa por TSM, después, otras causas constantemente(9)
TSM, después, TSM constantemente(2)
Alta Complejidad
Residuals
-1.037
3.436
-3.818
-0.841
3.699
0.201
-2.808
0.560
-0.156
Alta Complejidad
p values
1.000
0.026
0.006
1.000
0.010
1.000
0.224
1.000
1.000
Baja Complejidad
Residuals
0.866
1.777
0.151
-1.774
-2.844
-1.941
1.174
0.955
-0.303
Baja Complejidad
p values
1.000
1.000
1.000
1.000
0.201
1.000
1.000
1.000
1.000
Mediana Complejidad
Residuals
0.899
-5.065
3.416
1.298
-0.959
1.015
1.935
-1.288
0.779
Mediana Complejidad
p values
1.000
0.000
0.029
1.000
1.000
1.000
1.000
1.000
1.000
Pendiente
Residuals
-1.324
-2.883
3.212
3.525
-1.789
2.053
1.593
-0.615
-0.595
Pendiente
p values
1.000
0.177
0.059
0.019
1.000
1.000
1.000
1.000
1.000
Sin dato
Residuals
0.370
1.053
-0.222
0.315
-1.246
-1.032
-0.767
-0.339
-0.328
Sin dato
p values
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
1.000
Tiempo que demora esta sección: 0 minutos
1.1.3.j. Comparación covariables- Tratamientos
Code
#Definimos la base de datos que agrupa por observación y nos permite unirla con nuestros clusterdias_ttos_base<-data_long_establecimiento_2024_std %>% dplyr::group_by(run) %>% dplyr::mutate(diff_tr=fecha_ingreso_rec_fmt-lag(fecha_egreso_rec_fmt)) %>% dplyr::ungroup() %>% dplyr::group_by(run) %>% dplyr::summarise(n_ttos=n(), promedio_dias=mean(days_elapsed), promedio_diff_tr=mean(diff_tr,na.rm=T))table(as.numeric(dias_ttos_base$promedio_diff_tr)<0)invisible("20 menores a 0")dias_ttos_base$promedio_diff_tr<-ifelse(dias_ttos_base$promedio_diff_tr<0,-dias_ttos_base$promedio_diff_tr, dias_ttos_base$promedio_diff_tr)invisible("Prueba de Levene par igualdad de varianzas")with(dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, dias_ttos_base, by =c("run"="run"), multiple ="first"), car::leveneTest(n_ttos, clus_om9))#group 8 61.511 < 2.2e-16 ***# Realizar el ANOVA comparando la edad media entre los diferentes conglomerados (clus_pam)anova_n_ttos_om9 <-oneway.test(n_ttos ~ clus_om9, data = ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens%>% dplyr::inner_join(dias_ttos_base, by =c("run"="run"), multiple ="first"), var.equal = F)# Ver los resultados del ANOVAprint(anova_n_ttos_om9)#F = 75.483, num df = 8.00, denom df = 156.42, p-value < 2.2e-16rstatix::games_howell_test(n_ttos ~ clus_om9, data =ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens%>% dplyr::inner_join(dias_ttos_base, by =c("run"="run"), multiple ="first")) %>% dplyr::select(-1) %>% dplyr::mutate(summary =sprintf("%.2f [%.2f, %.2f], p= %s",as.numeric(estimate), as.numeric(conf.low), as.numeric(conf.high), ifelse(p.adj <0.001, "<0.001", sprintf("%.3f", p.adj)))) %>% dplyr::select(!any_of(c("estimate","conf.low", "conf.high", "p.adj", "p.adj.signif"))) %>% knitr::kable("markdown", col.names=c("Conglomerado1","Conglomerado2", "Estimación"), caption="Post-hoc, conglomerado vs. N°s días de tratamiento")
FALSE TRUE
2787 20
Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 8 61.511 < 2.2e-16 ***
6029
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
One-way analysis of means (not assuming equal variances)
data: n_ttos and clus_om9
F = 75.483, num df = 8.00, denom df = 156.42, p-value < 2.2e-16
Post-hoc, conglomerado vs. N°s días de tratamiento
Conglomerado1
Conglomerado2
Estimación
Un evento, TSM(1)
Un evento, TUS(4)
0.09 [-0.08, 0.27], p= 0.781
Un evento, TSM(1)
Un evento TSM larga duración(3)
1.64 [1.20, 2.08], p= <0.001
Un evento, TSM(1)
TSM, 1 año después, TSM(5)
2.32 [1.68, 2.95], p= <0.001
Un evento, TSM(1)
Un evento, comorbilidad(6)
0.56 [0.19, 0.93], p= <0.001
Un evento, TSM(1)
TSM, 2 años después, TSM(7)
1.62 [1.24, 2.00], p= <0.001
Un evento, TSM(1)
TSM, 2 años y medio después, TSM(8)
3.28 [2.09, 4.47], p= <0.001
Un evento, TSM(1)
Ingresa por TSM, después, otras causas constantemente(9)
7.36 [4.31, 10.42], p= <0.001
Un evento, TSM(1)
TSM, después, TSM constantemente(2)
7.43 [1.06, 13.80], p= 0.017
Un evento, TUS(4)
Un evento TSM larga duración(3)
1.55 [1.08, 2.02], p= <0.001
Un evento, TUS(4)
TSM, 1 año después, TSM(5)
2.22 [1.57, 2.87], p= <0.001
Un evento, TUS(4)
Un evento, comorbilidad(6)
0.47 [0.07, 0.87], p= 0.009
Un evento, TUS(4)
TSM, 2 años después, TSM(7)
1.53 [1.12, 1.93], p= <0.001
Un evento, TUS(4)
TSM, 2 años y medio después, TSM(8)
3.18 [1.98, 4.39], p= <0.001
Un evento, TUS(4)
Ingresa por TSM, después, otras causas constantemente(9)
7.27 [4.21, 10.33], p= <0.001
Un evento, TUS(4)
TSM, después, TSM constantemente(2)
7.34 [0.97, 13.71], p= 0.019
Un evento TSM larga duración(3)
TSM, 1 año después, TSM(5)
0.67 [-0.09, 1.44], p= 0.133
Un evento TSM larga duración(3)
Un evento, comorbilidad(6)
-1.08 [-1.65, -0.52], p= <0.001
Un evento TSM larga duración(3)
TSM, 2 años después, TSM(7)
-0.02 [-0.59, 0.55], p= 1.000
Un evento TSM larga duración(3)
TSM, 2 años y medio después, TSM(8)
1.64 [0.37, 2.90], p= 0.003
Un evento TSM larga duración(3)
Ingresa por TSM, después, otras causas constantemente(9)
5.72 [2.65, 8.80], p= <0.001
Un evento TSM larga duración(3)
TSM, después, TSM constantemente(2)
5.79 [-0.59, 12.16], p= 0.089
TSM, 1 año después, TSM(5)
Un evento, comorbilidad(6)
-1.76 [-2.48, -1.03], p= <0.001
TSM, 1 año después, TSM(5)
TSM, 2 años después, TSM(7)
-0.70 [-1.42, 0.03], p= 0.073
TSM, 1 año después, TSM(5)
TSM, 2 años y medio después, TSM(8)
0.96 [-0.38, 2.30], p= 0.369
TSM, 1 año después, TSM(5)
Ingresa por TSM, después, otras causas constantemente(9)
5.05 [1.95, 8.14], p= <0.001
TSM, 1 año después, TSM(5)
TSM, después, TSM constantemente(2)
5.12 [-1.27, 11.50], p= 0.169
Un evento, comorbilidad(6)
TSM, 2 años después, TSM(7)
1.06 [0.54, 1.58], p= <0.001
Un evento, comorbilidad(6)
TSM, 2 años y medio después, TSM(8)
2.72 [1.48, 3.96], p= <0.001
Un evento, comorbilidad(6)
Ingresa por TSM, después, otras causas constantemente(9)
6.80 [3.74, 9.87], p= <0.001
Un evento, comorbilidad(6)
TSM, después, TSM constantemente(2)
6.87 [0.50, 13.24], p= 0.030
TSM, 2 años después, TSM(7)
TSM, 2 años y medio después, TSM(8)
1.66 [0.41, 2.90], p= 0.002
TSM, 2 años después, TSM(7)
Ingresa por TSM, después, otras causas constantemente(9)
5.74 [2.68, 8.81], p= <0.001
TSM, 2 años después, TSM(7)
TSM, después, TSM constantemente(2)
5.81 [-0.56, 12.18], p= 0.087
TSM, 2 años y medio después, TSM(8)
Ingresa por TSM, después, otras causas constantemente(9)
4.09 [0.89, 7.29], p= 0.006
TSM, 2 años y medio después, TSM(8)
TSM, después, TSM constantemente(2)
4.15 [-2.27, 10.58], p= 0.390
Ingresa por TSM, después, otras causas constantemente(9)
Días de diferencia entre tratamientos (promedio y bigotes en IC95%)
Tiempo que demora esta sección: 0.1 minutos
1.1.4. Compilación comparación covariables
Code
# conglomerado vs. Pertenencia/identificación + Reconocimento CONADI PPOO#Test de fisher p=0,49#Si bien menores a n=30 (n=16 y 15), más se autoidentifican o tienen reconocimiento por la CONADI#A diferencia del conglomerado 1, los que tienen principalmente una recurrencia 2 años o 2 años y medio despés son más no pertenece/no se identifica (~85% vs. 79% el 1,4,3)#PPOO Binarizada= X-squared = 10.413, df = 8, p-value = 0.2372#Mortalidad vs. conglomerado#X-squared = 64.113, df = 8, p-value = 7.225e-11#p-value = 2e-05#El 20% de los del grupo 9 y el 7% (que son los que reingresan constantemente por otras causas) (Post hoc res.= 6.58, p=<0.001)#Pero también los de Un evento TSM larga duración(3) mueren más (Post-hoc res.= 2.24, p=0.4566)#Un evento, TSM(1) tiene menos (Posthoc res.=-4.10; p<0.001)#RM/noRM vs. conglomerado#X-squared = 53.905, df = 8, p-value = 7.203e-09##Un evento, TUS(4), menos en RM (post-hoc res.=-5.30, p<0.001)#TSM, 1 año después, TSM(5), más de RM (post-hoc res=3.00, p=0,048)#Un evento, comorbilidad(6), más de RM (post-hoc res=3.66, p=0.005)##Por macrozona#X-squared = 173.09, df = 40, p-value < 2.2e-16#p-value = 1e-05# Un evento, TSM(1), más Macrozona Norte (4.29 (p=0.001)), menos Sur (-5.12 (p=0.000))# Un evento, TUS(4), menos Macrozona Norte (-3.81 (p=0.007)), más Sur (8.85 (p=0.000)), menos RM (-4.95 (p=0.000))# Un evento, comorbilidad(6), más RM (3.75 (p=0.010)), # Conglomerado vs. Sexo# X-squared = 246.11, df = 8, p-value < 2.2e-16# Un evento, TSM(1), más mujeres (posthoc=9.55 <0.001)#Un evento, TUS(4), menos mujeres (posthoc= -13.55 p<0.001)#Un evento, comorbilidad(6) menos mujeres (posthoc= -6.83 <0.001)##Un evento de TS;larga duración. tiende a ser levemente menor al resto (en torno a los 20 años); mientras que Un evento, TUS(4), son mayor (en torno a los 22-23 años); seguido por quienes están por comorbildiad#Previsión y conglomerado#X-squared = 17.51, df = 8, p-value = 0.02521#p-value = 0.01839#TSM, 2 años después, TSM(7), menos en FONASA A#ISAPRE#X-squared = 14.445, df = 8, p-value = 0.07088#p-value = 0.05836#No sig.##Días de tratamiento#Mucho menos días, Un evento, TUS(4) (9 días prom) y Un evento, TSM(1) (11 días prom)#Muchos más días en primedio. TSM, después, TSM constantemente(2) (162 días prom)# 1 Un evento, TSM(1) 11.4 13.4 11.0 11.8# 2 Un evento, TUS(4) 9.32 18.8 7.90 10.7# 3 Un evento TSM larga duración(3) 27.6 39.7 23.3 32.0# 4 TSM, 1 año después, TSM(5) 22.6 36.6 17.8 27.4# 5 Un evento, comorbilidad(6) 26.4 80.6 15.4 37.4# 6 TSM, 2 años después, TSM(7) 18.5 19.6 15.3 21.8# 7 TSM, 2 años y medio después, TSM(8) 23.3 27.0 17.4 29.3# 8 Ingresa por TSM, después, otras causas constantemente(9)9.79 9.46 4.75 14.8# 9 TSM, después, TSM constantemente(2) 162. 250. 23.2 300. # Definir los datos correctamentedata_om9 <-data.frame(Grupo =c('1', '2', '3', '4', '5', '6', '7', '8', '9'),Mortalidad =c('-',NA, '+', NA, NA, NA, NA, NA, NA),Macrozona_Norte =c('+', '-', NA, NA, NA, NA, NA, NA, NA),Macrozona_Sur =c('-', '+', NA, NA, NA, NA, NA, NA, NA),RM =c(NA, '-', NA, '+', '+', NA, NA, NA, NA),Sexo_Mujeres =c('+', '-', NA, NA, '-', NA, NA, NA, NA),Edad =c(NA, '+', '-', NA, '+', NA, NA, NA, NA), Previsión =c(NA, NA, NA, NA, NA, '-', NA, NA, NA),Dias_en_tto =c(NA, '-', NA, NA, NA, '+', NA, NA, NA))## Asegurar que los nombres de las columnas sean válidos y no haya espacios en blancocolnames(data_om9) <-c('Grupo', 'Mortalidad', 'Macrozona\nNorte', 'Macrozona\nSur', 'RM', 'Sexo\n(Mujeres)', 'Edad', 'FONASA A', 'Dias_en\ntto.')# Derretir el dataframe para que sea adecuado para ggplot2data_melt_om9 <- reshape2::melt(data_om9, id.vars ='Grupo', variable.name ='Variable', value.name ='Asociación')# Reemplazar los NA por un valor vacíodata_melt_om9$Asociación[is.na(data_melt_om9$Asociación)] <-"\n"# Crear el gráfico con ggplotdata_melt_om9 %>% dplyr::mutate(Variable =gsub("_", " ", Variable)) %>%ggplot(aes(x = Variable, y = Grupo, fill = Asociación)) +geom_tile(color ="white", size =0.8) +scale_fill_manual(values =c("+"="#556B2F", "-"="#E2725B", "\n"="white")) +labs(title =NULL, x ="Variables", y ="Conglomerado") +theme_minimal() +theme(#axis.text.x = element_text(angle = 45, hjust = 1),panel.grid =element_blank())+theme(axis.text.y =element_text(size =17, face ="bold"),#,margin = margin(l = 7)), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =17, face ="bold"), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =16, face ="bold"),#,margin = margin(t = -15)), # Tamaño del título del eje Xaxis.title.y =element_text(size =16, face ="bold"), # Tamaño del título del eje Yplot.title =NULL, # Tamaño y estilo del título del gráficolegend.title =element_text(size =17, face ="bold"), # Tamaño del título de la leyendalegend.spacing.y =unit(1.5, "lines"),legend.box.spacing =unit(0.5, "lines"), # Controla el espacio entre la leyenda y el gráficolegend.margin =margin(5, 5, 5, 5), legend.key.height =unit(1, "cm"), legend.text =element_text(size =15, face ="bold") # Tamaño del texto de la leyenda ) +coord_flip()ggsave("_figs/asociaciones_om9.png", width=8.8*.8, height=5*.8, dpi=1000)
Comparación covariables con agrupamiento 9 conglomerados
Tiempo que demora esta sección: 0.1 minutos
2. PAM (OM), sol 6 cluster
2.1. PAM (OM), sol 6 cluster- diagnósticos
Code
invisible("info de validación de modelos con bootstrap")# PAM Trimestral= La solución de 4 y 6 o 7 cluster parecen tener buenos índices de calidad. # De todas formas, los índices ASW se encuentran en niveles que reflejan buena calidad, # 6 - 7 cluster reflejan de mejor forma las distancias entre los puntos.# # Comb= ASW todos sobre umbral (density, todos sobre distribución); HC todos sobre # umbral (density, 7 a 10, 3 y 2 sobre el umbral); HG debajo umbral (density, 3 a 15 # debajo distribución, 2 en distribución); PBC debajo umbral (density, 12 y 13 en distribución# , 14 y 15 sobre, 2 a 11, debajo)# Seq= ASW todos sobre umbral (2 en distribución, 3 en adelante, sobre distribución); # HC 2 a 9 sobre umbral (density, todos debajo); 6 en adelante sobre umbral HG # (density, 5 en adelante sobre distribución, resto en distribución); PBC sobre umbral # desde 5 en adelante (density, sobre distribución desde 6 en adelante) # 6 EN ADELANTE PODRÍA SER DISTINTO A NULO# invisible("Hacemos clasificación de pertenencia cluster y ponemos etiquetas")ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam <-factor(pamRange_quarter_om$clustering$cluster6,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name")),labels=c("6035_Un evento, TSM", "6025_Un evento, TUS", "5939_Un evento TSM larga duración", "5989_Un evento, comorbilidad", "6036_TSM, 1 año después, otras causas", "5710_TSM, 1 año después, TSM"))
Tiempo que demora esta sección: 0 minutos
Vemos los diagnósticos que vienen después de aquellos cluster con más de un ingreso.
Code
diag_6036<-df_filled %>% dplyr::filter(run %in%subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, clus_pam=="6036_TSM, 1 año después, otras causas")$run) %>% dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) %>% dplyr::group_by(run) %>% dplyr::filter(row_number() !=1) %>%# Elimina la primera observación de cada run dplyr::mutate(all_diags =paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse =", ") ) %>% dplyr::summarise(all_diags =first(all_diags),fecha_egreso_rec_fmt =first(fecha_egreso_rec_fmt),estab_homo =first(estab_homo) ) %>% dplyr::ungroup() %>% dplyr::pull(all_diags) %>%# Extraer la columna all_diags como vectorstrsplit(split =", ") %>%# Separar cada diagnóstico por comasunlist() # Convertir la lista en un vector# 1. **F192** (25, 2.96%): Trastorno mental y del comportamiento debido al uso de múltiples drogas y al uso de otras sustancias psicoactivas, síndrome de abstinencia.# 2. **F609** (17, 2.01%): Trastorno específico de la personalidad no especificado.# 3. **O800** (17, 2.01%): Parto espontáneo por vía vaginal.# 4. **F603** (16, 1.89%): Trastorno de la personalidad emocionalmente inestable, tipo impulsivo.# 5. **E101** (15, 1.77%): Diabetes mellitus insulino-dependiente, no controlada.# 6. **Z370** (14, 1.65%): Nacimiento de un solo feto nacido vivo.# 7. **F322** (13, 1.54%): Episodio depresivo grave sin síntomas psicóticos.# 8. **G409** (13, 1.54%): Epilepsia, no especificada.# 9. **N390** (13, 1.54%): Infección del tracto urinario, sitio no especificado.# 10. **Z518** (13, 1.54%): Otras atenciones médicas especificadas.# 11. **T509** (10, 1.18%): Envenenamiento por otros psicotrópicos y sustancias psicotrópicas no especificadas.# 12. **G629** (8, 0.95%): Polineuropatía, no especificada.# 13. **K358** (8, 0.95%): Apendicitis crónica.# 14. **N10X** (8, 0.95%): Nefritis tubulointersticial aguda.# 15. **O829** (8, 0.95%): Parto por cesárea no especificado.# 16. **F191** (7, 0.83%): Trastorno mental y del comportamiento debido al uso de múltiples drogas y al uso de otras sustancias psicoactivas, dependencia actual.# 17. **F329** (7, 0.83%): Episodio depresivo no especificado.# 18. **Z291** (7, 0.83%): Asesoramiento sobre la prevención del abuso de sustancias psicoactivas.# 19. **F199** (6, 0.71%): Trastorno mental y del comportamiento debido al uso de múltiples drogas y al uso de otras sustancias psicoactivas, no especificado.# 20. **K808** (6, 0.71%): Cálculo de la vesícula biliar sin colecistitis.# 21. **O470** (6, 0.71%): Falso trabajo de parto.# 22. **O809** (6, 0.71%): Parto por vía vaginal no especificado.# 23. **O821** (5, 0.59%): Parto por cesárea electiva.# 24. **R458** (5, 0.59%): Otros síntomas y signos que involucran el estado emocional.# 25. **X590** (5, 0.59%): Exposición a otros factores no especificados.# 26. **Z910** (5, 0.59%): Antecedentes personales de riesgo no especificado.# invisible("6035 (n=4476): trayectoria con sólo un evento hosp por TSM")invisible("6025 (n=680): trayectoria con sólo un evento hosp. con TUS")invisible("5939 (n=319): trayectoria con 2 trimestres continuis por morbilidad psiquiátrica")invisible("5989 (n=207): trayectoria de sólo un evento en por comorbilidad")invisible("6036 (n=202): trayectoria de morbilidad, pero a los 4 trimestres posteriores tienen ingresos por otras causas")invisible("cuáles son esas causas principalmente??, son distintas de las que tiene la población?")invisible("5710 (n=154): trayectoria de morbilidad, pero a los 4 trimestres posteriores tienen ingresos por morbilidad")invisible("qué morbilidad principalmente??, son distintas de las que tiene la población?")
Tiempo que demora esta sección: 0 minutos
Code
diag_5710<- df_filled %>% dplyr::filter(run %in%subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, clus_pam=="5710_TSM, 1 año después, TSM")$run) %>% dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) %>% dplyr::group_by(run) %>% dplyr::filter(row_number() !=1) %>%# Elimina la primera observación de cada run dplyr::mutate(all_diags =paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse =", ") ) %>% dplyr::summarise(all_diags =first(all_diags),fecha_egreso_rec_fmt =first(fecha_egreso_rec_fmt),estab_homo =first(estab_homo) ) %>% dplyr::ungroup() %>% dplyr::pull(all_diags) %>%# Extraer la columna all_diags como vectorstrsplit(split =", ") %>%# Separar cada diagnóstico por comasunlist() # Convertir la lista en un vector# # 1. **F603** (71, 5.97%): Trastorno de la personalidad emocionalmente inestable, tipo impulsivo.# 2. **F609** (54, 4.54%): Trastorno específico de la personalidad no especificado.# 3. **F329** (51, 4.29%): Episodio depresivo no especificado.# 4. **F322** (47, 3.95%): Episodio depresivo grave sin síntomas psicóticos.# 5. **F319** (43, 3.61%): Trastorno depresivo recurrente, episodio no especificado.# 6. **F209** (42, 3.53%): Esquizofrenia, no especificada.# 7. **F200** (40, 3.36%): Esquizofrenia paranoide.# 8. **F192** (33, 2.77%): Trastorno mental y del comportamiento debido al uso de múltiples drogas y al uso de otras sustancias psicoactivas, síndrome de abstinencia.# 9. **C490** (29, 2.44%): Tumor maligno de tejido mesotelial y tejido blando, sitio no especificado.# 10. **G909** (21, 1.76%): Trastorno no especificado del sistema nervioso autónomo.# 11. **Z511** (20, 1.68%): Atención para tratamiento de tumores malignos.# 12. **F432** (17, 1.43%): Reacción de estrés agudo.# 13. **F431** (16, 1.34%): Trastorno de estrés postraumático.# 14. **F449** (15, 1.26%): Trastorno de ansiedad no especificado.# 15. **F070** (14, 1.18%): Trastornos orgánicos de la personalidad.# 16. **Z915** (14, 1.18%): Historia personal de lesión autoinfligida.# 17. **F191** (12, 1.01%): Trastorno mental y del comportamiento debido al uso de múltiples drogas y al uso de otras sustancias psicoactivas, dependencia actual.# 18. **E669** (11, 0.92%): Obesidad no especificada.# 19. **T424** (11, 0.92%): Intoxicación por otros psicotrópicos.# 20. **F608** (10, 0.84%): Otros trastornos específicos de la personalidad.# 21. **G409** (10, 0.84%): Epilepsia, no especificada.
Generamos un gráfico de PPOO por cada conglomerado.
Code
ppoo_clus<- df_filled[,c("run","glosa_pueblo_originario")] %>% dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run", "clus_pam","factor_inclusivo_real_hist_mas_autperc")], by="run", multiple="first") %>% dplyr::mutate(glosa_pueblo_originario_rec= dplyr::case_when(glosa_pueblo_originario=="NINGUNO"& factor_inclusivo_real_hist_mas_autperc!="00"~"DESCONOCIDO", T~glosa_pueblo_originario)) %>% janitor::tabyl(glosa_pueblo_originario_rec, clus_pam) %>% janitor::adorn_percentages("row")reshape2::melt(ppoo_clus, id.vars ="glosa_pueblo_originario_rec") %>% dplyr::mutate(glosa_pueblo_originario_rec= dplyr::recode(glosa_pueblo_originario_rec, "OTRO (ESPECIFICAR)"="OTRO(n=77)", "RAPA NUI (PASCUENSE)"="RAPA NUI(n=34)", "YAGÁN (YÁMANA)"="YAGÁN(n=2)","AYMARA"="AYMARA(n=13)","COLLA"="COLLA(n=6)","DIAGUITA"="DIAGUITA(n=3)","KAWÉSQAR"="KAWÉSQAR(n=4)","MAPUCHE"="MAPUCHE(n=255)","DESCONOCIDO"=".DESCONOCIDO(n=1.985)","NINGUNO"=".NINGUNO(n=9.156)")) %>%#dplyr::filter(glosa_pueblo_originario!="NINGUNO") %>% # dplyr::mutate(variable= # dplyr::recode(variable, "6036_TSM, 1 año después, otras causas"="6036_TSM, 1 año\ndespués, otras causas",# "5710_TSM, 1 año después, TSM"="5710_TSM, 1 año\ndespués, TSM",# "5939_Un evento TSM larga duración"="5939_Un evento TSM\nlarga duración",# "5989_Un evento, comorbilidad"="5989_Un evento,\ncomorbilidad")) %>% ggplot(aes(x = glosa_pueblo_originario_rec, y = value, fill = variable)) +geom_bar(stat ="identity", position ="fill") +scale_fill_manual(values =c("#E27A5B","#6B8E23", "#D2B48C", "#696969", "#BDB76B", "#4682B4")) +labs(title =NULL,x ="Grupo Étnico",y ="Proporción de Casos",fill ="Grupos") +# Cambia el título de la leyenda a "Grupos"theme_minimal() +theme(axis.text.y =element_text(size =12), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =12), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =14), # Tamaño del título del eje Xaxis.title.y =element_text(size =14), # Tamaño del título del eje Yplot.title =NULL, # Tamaño y estilo del título del gráficolegend.title =element_text(size =14, margin =margin(b =-.1)), # Tamaño del título de la leyendalegend.spacing.y =unit(1.5, "lines"),legend.box.spacing =unit(0.5, "lines"), # Controla el espacio entre la leyenda y el gráficolegend.margin =margin(5, 5, 5, 5), legend.key.height =unit(1, "cm"), legend.text =element_text(size =12) # Tamaño del texto de la leyenda ) +coord_flip() # Hacer el gráfico horizontalggsave("grafico_ancho_achatado.png", width =8, height =3, dpi=1000)
PPOO por cluster
Tiempo que demora esta sección: 0 minutos
Vemos los gráficos de las trayectorias
Code
categories<-attr(States_Wide.seq_quarter_t_prim_adm_cens, "labels")new_labels <- categoriesnew_labels[which(categories =="Otras causas")] <-"Otras\ncausas"#new_labels[which(categories == "Consumo\nde sustancias")] <- "Consumo de\nsustancias"seq_plot <-ggseqiplot(States_Wide.seq_quarter_t_prim_adm_cens, group=factor(pamRange_quarter_om$clustering$cluster6,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name"))), facet_ncol=3, facet_nrow=3) +theme(legend.position ="none")+labs(x="Trimestres", y="# IDs de usuarios")+#guides(fill = guide_legend(nrow = 1))+theme(axis.text.y =element_text(size =15), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =15), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =15), # Tamaño del título del eje Xaxis.title.y =element_text(size =15, margin =margin(r =-10)),#,margin = margin(l = -10)),strip.text =element_text(size =16, margin =margin(b =-15)),legend.text =element_text(size =15),legend.spacing.x =unit(0.1, 'cm'), # Alinea el título de la leyenda hacia la izquierdalegend.box.margin =margin(t =0, r =0, b =0, l =-50),legend.position ="bottom", legend.justification ="left",panel.spacing.y =unit(0.5, "lines")#legend.key.size = unit(1.5, "lines"), # Aumenta el tamaño de los símbolos en la leyenda )+guides(fill =guide_legend(nrow =1)) +scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513","#FFFFFF","#808080","#000000"))seq_plotggsave(filename="clusterspam_om6_mod.png",seq_plot, width =8.5, height =5.5, dpi=1000)table_data_pam6 <-sprintf("%1.2f",pamRange_quarter_om$stats[5,])table_data_pam6 <-as.data.frame(t(table_data_pam6))colnames(table_data_pam6)<-attr(pamRange_quarter_om$stats, "name")table_data_pam6 %>% knitr::kable()
PBC
HG
HGSD
ASW
ASWw
CH
R2
CHsq
R2sq
HC
0.59
0.78
0.77
0.60
0.60
775.27
0.39
1199.95
0.50
0.10
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico.
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico.
Tiempo que demora esta sección: 0.3 minutos
Code
seq_plot2 <-ggseqdplot(States_Wide.seq_quarter_t_prim_adm_cens, group=factor(pamRange_quarter_om$clustering$cluster6,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name"))), facet_ncol=3, facet_nrow=3) +theme(legend.position ="none")+# Colocar la leyenda abajolabs(x="Trimestres", y="Frecuencia relativa de estados")+theme(axis.text.y =element_text(size =15), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =15), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =15), # Tamaño del título del eje Xaxis.title.y =element_text(size =15, margin =margin(r =-5)),strip.text =element_text(size =15),panel.spacing.y =unit(0.5, "lines") ) # Colocar la leyenda abajoseq_plot2ggsave("clusterspam_om62_mod.png",seq_plot2, width =8, height =5.5, dpi=1000)
Trayectorias de hospitalización, frecuencia relativa de estados en un gráfico de barras apiladas por trimestre.
Tiempo que demora esta sección: 0.1 minutos
De este modo, presenta el cambio agregado en la distribución de estados a lo largo del tiempo, sin considerar las secuencias individuales.
2.1.1.Exploración transiciones
2.1.1.a Transiciones- RM y no RM
Tasas de transición no RM a RM y viceversa
Code
invisible("Tasas de transición no RM a RM y viceversa")trim_tasa_pam_clus6_cens_cnt<-seqcount_t(States_Wide.seq_quarter_t_prim_adm_RM_cens, group=factor(pamRange_quarter_om$clustering$cluster6,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name")))) %>% dplyr::filter(count>0) %>% dplyr::mutate(trans =paste0(from,"_", to)) %>% dplyr::mutate(across(c("from","to"),~gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) trim_tasa_pam_clus6_cens_rate<-seqtrate_t(States_Wide.seq_quarter_t_prim_adm_RM_cens, group=factor(pamRange_quarter_om$clustering$cluster6,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name")))) %>% dplyr::filter(rate>0) %>% dplyr::mutate(trans =paste0(from,"_", to)) %>% dplyr::mutate(across(c("from","to"),~gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))
Tiempo que demora esta sección: 0 minutos
Code
trim_tasa_pam_clus6_cens_rate %>% dplyr::left_join(trim_tasa_pam_clus6_cens_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% dplyr::rename("recuento"="count") %>% dplyr::filter(from %in%c("RM", "noRM")) %>% dplyr::mutate(glosa_sexo=factor(glosa_sexo,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name")))) %>%ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +geom_tile() +coord_flip()+scale_fill_gradient(low ="white", high ="blue") +# Ajusta la escala de colores según tus preferenciaslabs(title ="Tasas de transición, Trimestre (s/censura)",x ="Desde",y ="Hacia",fill ="Rate") +theme_minimal() +facet_wrap(~glosa_sexo)+theme(axis.text.x =element_text(angle =45, hjust =1))+geom_text(aes(label =sprintf("%1.2f", rate), size =log(recuento+1)*.5), color ="black")invisible("Hay muy pocos casos que se entrecruzan entre noRM y RM (fuera de la diagnonal)")
Porcentajes de transición no-RM y RM por cada cluster
Tiempo que demora esta sección: 0.1 minutos
Hay muy pocos casos que se entrecruzan entre noRM y RM (fuera de la diagnonal)
trim_tasa2_pam_clus6_cens_rate %>% dplyr::left_join(trim_tasa2_pam_clus6_cens_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% dplyr::rename("recuento"="count") %>%#dplyr::filter(from %in% c("RM", "noRM")) %>% dplyr::mutate(glosa_sexo=factor(glosa_sexo,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name")))) %>%ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +geom_tile() +coord_flip()+scale_fill_gradient(low ="white", high ="blue") +# Ajusta la escala de colores según tus preferenciaslabs(title ="Tasas de transición, Trimestre (s/censura)",x ="Desde",y ="Hacia",fill ="Rate") +theme_minimal() +facet_wrap(~glosa_sexo)+theme(axis.text.x =element_text(angle =45, hjust =1))+geom_text(aes(label =sprintf("%1.2f", rate), size =log(recuento+1)*.5), color ="black")
Porcentajes de transición no-RM y RM por cada cluster
Tiempo que demora esta sección: 0.1 minutos
2.1.1.c Tiempo promedio por cluster
Code
seq_mean_t(States_Wide.seq_quarter_t_prim_adm_cens, factor(pamRange_quarter_om$clustering$cluster6,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name"))))%>% data.table::as.data.table(keep.rowname=T) %>%ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+geom_bar(width =1, stat ="identity") +theme_minimal() +labs(title =NULL,x =NULL,y =NULL) +coord_flip()+theme(#axis.text.x = element_blank(),#axis.text.y = element_blank(),panel.grid =element_blank()) +# scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +geom_text(aes(label =round(Mean,1)), position =position_stack(vjust =0.5), size =2.5, # Ajusta el tamaño de la fuente aquícolor ="black", # Color del textofamily ="sans", # Puedes cambiar la fuente si lo deseasbackground =element_rect(fill ="white", color =NA)) +# Fondo blancotheme(legend.title =element_blank())invisible("No me aporta mucho")# seq_mean_t_dos_grupos(States_Wide.seq_quarter_t_prim_adm_cens, group1=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam, group2=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc)
Tiempo promedio en cada estado por estatus PPOO (Trimestral c/censura)
Tiempo que demora esta sección: 0.1 minutos
2.1.2. Propiedades secuencias
Vemos el número de transiciones, número de subsecuencias y la entropía
Code
## number of transitions ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$ntrans <-as.numeric(seqtransn(States_Wide.seq_quarter_t_prim_adm))## number of subsequencesing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$subsn <-as.numeric(seqsubsn(States_Wide.seq_quarter_t_prim_adm))ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$entropy_long <-as.numeric(seqient(States_Wide.seq_quarter_t_prim_adm))ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::group_by(clus_pam) %>% dplyr::summarise(promedio_entropia=mean(entropy_long), mediana_entropia=quantile(entropy_long, .5),p25_entropia=quantile(entropy_long, .25),p75_entropia=quantile(entropy_long, .75),promedio_n_trans=mean(ntrans), #Las transiciones se refieren a los cambios de estado en las secuencias.sd_n_trans=sd(ntrans), #subsecuencia es una parte de una secuencia más larga que respeta el orden temporal original, #pero no necesariamente contiene todos los estadospromedio_subsn=mean(subsn), sd_subsn=sd(subsn)) %>% dplyr::mutate_if(is.numeric, ~sprintf("%1.2f", .)) %>% knitr::kable("html", col.names =c("Cluster", "Promedio Entropía", "Mediana Entropía", "Entropía Percentil 25", "Entropía Percentil 75", "Promedio Número de Transiciones", "Desviación Estándar Número de Transiciones", "Promedio Número de Subsecuencias", "Desviación Estándar Número de Subsecuencias"), caption="Resumen de Métricas por Cluster")
Resumen de Métricas por Cluster
Cluster
Promedio Entropía
Mediana Entropía
Entropía Percentil 25
Entropía Percentil 75
Promedio Número de Transiciones
Desviación Estándar Número de Transiciones
Promedio Número de Subsecuencias
Desviación Estándar Número de Subsecuencias
6035_Un evento, TSM
0.16
0.12
0.12
0.20
1.71
1.20
9.38
46.91
6025_Un evento, TUS
0.18
0.12
0.12
0.25
1.78
1.34
10.95
27.85
5939_Un evento TSM larga duración
0.28
0.26
0.20
0.32
2.24
1.68
17.64
52.58
5989_Un evento, comorbilidad
0.20
0.12
0.12
0.25
2.00
1.39
13.92
41.49
6036_TSM, 1 año después, otras causas
0.33
0.32
0.25
0.38
4.35
1.63
50.74
76.27
5710_TSM, 1 año después, TSM
0.37
0.38
0.27
0.43
4.62
1.99
57.57
83.32
Tiempo que demora esta sección: 0 minutos
2.1.3. Comparación variables
2.1.3.a. Comparación covariables- PPOO
Code
# round(# prop.table(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam, # ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc),1),# 2)ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>%count(clus_pam, factor_inclusivo_real_hist_mas_autperc) %>%group_by(clus_pam) %>%mutate(prop = scales::percent(n /sum(n))) %>%select(-n) %>%pivot_wider(names_from = factor_inclusivo_real_hist_mas_autperc, values_from = prop, values_fill ="0") %>% knitr::kable("markdown", col.names=c("Conglomerados","No se identifica/no pertenece", "No se identifica/hay reconocimiento", "Se identifica/hay reconocimeinto"), caption="Porcentajes por fila, conglomerado vs. Pertenencia/identificación + Reconocimento CONADI PPOO")# 00 10 11# 6035 0.81 0.11 0.08# 6025 0.79 0.12 0.10# 5939 0.83 0.11 0.07# 5989 0.84 0.09 0.08# 6036 0.80 0.11 0.09# 5710 0.79 0.12 0.09invisible("6025 tiwnw un poxo mas PPOO, lo mismo con 5710")
Porcentajes por fila, conglomerado vs. Pertenencia/identificación + Reconocimento CONADI PPOO
Conglomerados
No se identifica/no pertenece
No se identifica/hay reconocimiento
Se identifica/hay reconocimeinto
6035_Un evento, TSM
80.6%
11.2%
8.2%
6025_Un evento, TUS
78.5%
11.6%
9.9%
5939_Un evento TSM larga duración
82.8%
10.7%
6.6%
5989_Un evento, comorbilidad
83.57%
8.70%
7.73%
6036_TSM, 1 año después, otras causas
79.7%
11.4%
8.9%
5710_TSM, 1 año después, TSM
79.2%
11.7%
9.1%
Tiempo que demora esta sección: 0 minutos
Vemos las categorías de clasificación de PPOO según autopercepción (en MINSAL y en RSH) y reconocimiento CONADI.
Pearson's Chi-squared test
data: .
X-squared = 5.6334, df = 10, p-value = 0.8451
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.8454
alternative hypothesis: two.sided
round(prop.table(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam, ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc_bin),1),2) %>% knitr::kable("markdown", col.names=c("Conglomerados","No se identifica/no pertenece", "Se identifica/pertenece"), caption="Porcentajes por fila, conglomerado vs. Pertenencia/identificación PPOO")
Porcentajes por fila, conglomerado vs. Pertenencia/identificación PPOO
Conglomerados
No se identifica/no pertenece
Se identifica/pertenece
6035_Un evento, TSM
0.81
0.19
6025_Un evento, TUS
0.79
0.21
5939_Un evento TSM larga duración
0.83
0.17
5989_Un evento, comorbilidad
0.84
0.16
6036_TSM, 1 año después, otras causas
0.80
0.20
5710_TSM, 1 año después, TSM
0.79
0.21
Tiempo que demora esta sección: 0 minutos
Hicimos una prueba post-hoc usando Bonferroni
Code
# # Beasley, T. M., & Schumacker, R. E. (1995). Multiple Regression Approach to Analyzing Contingency# Tables: Post Hoc and Planned Comparison Procedures. The Journal of Experimental Education, 64(1), 79–93. https://doi.org/10.1080/00220973.1995.9943797chisq.posthoc.test(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam, ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc_bin), method ="bonferroni") %>%pivot_longer(cols =c(`0`, `1`), names_to ="Group", values_to ="Values") %>%pivot_wider(names_from = Value, values_from = Values) %>%separate(Dimension, into =c("Code", "Evento"), sep ="_", extra ="merge") %>% dplyr::filter(Group==1) %>% dplyr::mutate(Residuals=sprintf("%1.2f", Residuals)) %>%select(Code, Evento, Residuals, `p values`) %>% knitr::kable("markdown", col.names=c("Código","Descripción", "Residuos", "Sig."), caption="Post-hoc, conglomerado vs. Pertenencia/identificación PPOO")
Post-hoc, conglomerado vs. Pertenencia/identificación PPOO
Código
Descripción
Residuos
Sig.
6035
Un evento, TSM
-0.30
1
6025
Un evento, TUS
1.41
1
5939
Un evento TSM larga duración
-1.03
1
5989
Un evento, comorbilidad
-1.12
1
6036
TSM, 1 año después, otras causas
0.31
1
5710
TSM, 1 año después, TSM
0.42
1
Tiempo que demora esta sección: 0 minutos
2.1.3.b. Comparación covariables- Mortalidad
Code
# invisible("No hay nada, el tiempo promedio de censura es similar")ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% janitor::tabyl(clus_pam,death_time_rec) %>% janitor::adorn_percentages("row")%>% dplyr::mutate(`1`=scales::percent(`1`, accuracy=.1)) %>% dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::group_by(clus_pam) %>% dplyr::summarise(mean=sprintf("%1.1f",mean(cens_time))), by="clus_pam") %>% dplyr::select(-`0`) %>% knitr::kable("markdown", col.names=c("Conglomerado","Mortalidad observada", "Promedio"), caption="Post-hoc, conglomerado vs.Mortalidad y tiempo a censura")
Post-hoc, conglomerado vs.Mortalidad y tiempo a censura
Conglomerado
Mortalidad observada
Promedio
6035_Un evento, TSM
0.9%
17.9
6025_Un evento, TUS
1.9%
18.2
5939_Un evento TSM larga duración
2.2%
18.0
5989_Un evento, comorbilidad
1.9%
18.1
6036_TSM, 1 año después, otras causas
1.0%
17.8
5710_TSM, 1 año después, TSM
1.9%
18.1
Tiempo que demora esta sección: 0 minutos
Code
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% janitor::tabyl(death_time_rec,clus_pam) %>% janitor::chisq.test(correct=T)#X-squared = 10.621, df = 5, p-value = 0.05943ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% janitor::tabyl(death_time_rec,clus_pam) %>% janitor::fisher.test(simulate.p.value=T, B=1e5)#p-value = 0.03169invisible("no se basa en la distribución chi-cuadrado. Fisher se basa en permutaciones exactas, por lo que no se calculan df.")invisible("Podría haber algo aquí, aunque son números pequeños")invisible("6036 (morbilidad y a los 4 meses otras causas) y 6035 (sólo un evento por trno.SM) tienen un 1% de gente que muere antes")invisible("5939 (dos semestres continuos por morbilidad psiquiátrica) en cambio, tiene 2.2%")#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_##_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_tabla_cluster_mortalidad<- ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1))chisq.posthoc.test(table(tabla_cluster_mortalidad$clus_pam, tabla_cluster_mortalidad$death_time_rec))%>%pivot_longer(cols =c(`0`, `1`), names_to ="Group", values_to ="Values") %>%pivot_wider(names_from = Value, values_from = Values) %>%separate(Dimension, into =c("Code", "Evento"), sep ="_", extra ="merge") %>% dplyr::filter(Group==1) %>% dplyr::mutate(Residuals=sprintf("%1.2f", as.numeric(Residuals))) %>%select(Code, Evento, Residuals, `p values`) %>% knitr::kable("markdown", col.names=c("Código","Descripción", "Residuos", "Sig."), caption="Post-hoc, conglomerado vs. mortalidad")
Pearson's Chi-squared test
data: .
X-squared = 10.621, df = 5, p-value = 0.05943
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.03154
alternative hypothesis: two.sided
Post-hoc, conglomerado vs. mortalidad
Código
Descripción
Residuos
Sig.
6035
Un evento, TSM
-2.99
0.0335*
6025
Un evento, TUS
1.95
0.6201
5939
Un evento TSM larga duración
1.77
0.9118
5989
Un evento, comorbilidad
1.06
1
6036
TSM, 1 año después, otras causas
-0.23
1
5710
TSM, 1 año después, TSM
0.93
1
Tiempo que demora esta sección: 0 minutos
2.1.3.c. Comparación covariables- no RM vs. RM
Code
round(prop.table(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam, ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$codigo_region_rec_base),1),2) %>% knitr::kable("markdown", caption="Porcentajes por fila")
tabla_cluster_region<-ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], by =c("estab_homo_base"="ESTAB_HOMO"), multiple ="first") %>% janitor::tabyl(codigo_region, clus_pam) %>% janitor::adorn_percentages("col") %>% janitor::adorn_rounding(digits =2)colnames(tabla_cluster_region)<-c("reg", "c6035", "c6025", "c5939", "c5989", "c6036", "c5710")cod_reg_homo<-data.frame(codigo_region =1:16,nombre_region =c("Región de Tarapacá","Región de Antofagasta","Región de Atacama","Región de Coquimbo","Región de Valparaíso","Región del Libertador General Bernardo O'Higgins","Región del Maule","Región del Biobío","Región de La Araucanía","Región de Los Lagos","Región de Aysén del General Carlos Ibáñez del Campo","Región de Magallanes y de la Antártica Chilena","Región Metropolitana de Santiago","Región de Los Ríos","Región de Arica y Parinacota","Región de Ñuble" ),stringsAsFactors =FALSE)dplyr::mutate(tabla_cluster_region, promedio_fila =rowMeans(across(2:7))) %>% dplyr::arrange(desc(promedio_fila)) %>% dplyr::left_join(cod_reg_homo, by=c("reg"="codigo_region")) %>% dplyr::select(reg, nombre_region, everything()) %>% dplyr::select(-promedio_fila) %>% dplyr::mutate_at(3:8,~scales::percent(.)) %>% knitr::kable(caption="Porcentaje por comunas")
Porcentaje por comunas
reg
nombre_region
c6035
c6025
c5939
c5989
c6036
c5710
13
Región Metropolitana de Santiago
45%
36%
48%
57%
45%
44%
8
Región del Biobío
10%
9%
9%
9%
12%
10%
5
Región de Valparaíso
9%
13%
10%
6%
6%
8%
10
Región de Los Lagos
6%
20%
5%
11%
6%
3%
7
Región del Maule
4%
3%
3%
4%
7%
5%
9
Región de La Araucanía
5%
4%
5%
4%
2%
5%
6
Región del Libertador General Bernardo O’Higgins
4%
3%
5%
2%
4%
1%
16
Región de Ñuble
2%
2%
2%
1%
3%
4%
2
Región de Antofagasta
2%
1%
4%
1%
0%
5%
14
Región de Los Ríos
3%
3%
2%
0%
2%
3%
1
Región de Tarapacá
2%
1%
1%
1%
2%
5%
12
Región de Magallanes y de la Antártica Chilena
1%
2%
2%
1%
2%
3%
11
Región de Aysén del General Carlos Ibáñez del Campo
Edad promedio primer ingreso con intervalo de confianza por conglomerado
Tiempo que demora esta sección: 0.1 minutos
Code
anova <-oneway.test(min_edad_anos ~ clus_pam, data = dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>% dplyr::filter(quarter ==0) %>% dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_pam")], by="run"),var.equal = F)# Ver los resultados del ANOVAprint(anova)
One-way analysis of means (not assuming equal variances)
data: min_edad_anos and clus_pam
F = 31.673, num df = 5.00, denom df = 604.01, p-value < 2.2e-16
Pearson's Chi-squared test
data: .
X-squared = 34.049, df = 20, p-value = 0.0258
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.02284
alternative hypothesis: two.sided
Porcentajes por columna, conglomerado vs. Beneficios
Pearson's Chi-squared test
data: .
X-squared = 3.0869, df = 5, p-value = 0.6866
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.6756
alternative hypothesis: two.sided
Pearson's Chi-squared test
data: .
X-squared = 4.0391, df = 5, p-value = 0.5438
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: .
p-value = 0.5529
alternative hypothesis: two.sided
#Definimos la base de datos que agrupa por observación y nos permite unirla con nuestros clusterdias_ttos_base<-data_long_establecimiento_2024_std %>% dplyr::group_by(run) %>% dplyr::mutate(diff_tr=fecha_ingreso_rec_fmt-lag(fecha_egreso_rec_fmt)) %>% dplyr::ungroup() %>% dplyr::group_by(run) %>% dplyr::summarise(n_ttos=n(), promedio_dias=mean(days_elapsed), promedio_diff_tr=mean(diff_tr,na.rm=T))table(as.numeric(dias_ttos_base$promedio_diff_tr)<0)invisible("20 menores a 0")dias_ttos_base$promedio_diff_tr<-ifelse(dias_ttos_base$promedio_diff_tr<0,-dias_ttos_base$promedio_diff_tr, dias_ttos_base$promedio_diff_tr)invisible("Prueba de Levene par igualdad de varianzas")with(dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, dias_ttos_base, by =c("run"="run"), multiple ="first"), car::leveneTest(n_ttos, clus_pam))# Realizar el ANOVA comparando la edad media entre los diferentes conglomerados (clus_pam)anova_n_ttos <-oneway.test(n_ttos ~ clus_pam, data = ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens%>% dplyr::inner_join(dias_ttos_base, by =c("run"="run"), multiple ="first"), var.equal = F)# Ver los resultados del ANOVAprint(anova_n_ttos)#F = 101.98, num df = 5.00, denom df = 570.85, p-value < 2.2e-16rstatix::games_howell_test(n_ttos ~ clus_pam, data =ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens%>% dplyr::inner_join(dias_ttos_base, by =c("run"="run"), multiple ="first")) %>% dplyr::select(-1) %>% dplyr::mutate(summary =sprintf("%.2f [%.2f, %.2f], p= %s",as.numeric(estimate), as.numeric(conf.low), as.numeric(conf.high), ifelse(p.adj <0.001, "<0.001", sprintf("%.3f", p.adj)))) %>% dplyr::select(!any_of(c("estimate","conf.low", "conf.high", "p.adj", "p.adj.signif"))) %>% knitr::kable("markdown", col.names=c("Conglomerado1","Conglomerado2", "Estimación"), caption="Post-hoc, conglomerado vs. N°s días de tratamiento")
FALSE TRUE
2787 20
Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 5 95.597 < 2.2e-16 ***
6032
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
One-way analysis of means (not assuming equal variances)
data: n_ttos and clus_pam
F = 101.98, num df = 5.00, denom df = 570.85, p-value < 2.2e-16
Post-hoc, conglomerado vs. N°s días de tratamiento
Días de diferencia entre tratamientos (promedio y bigotes en IC95%)
Tiempo que demora esta sección: 0.1 minutos
2.1.4. Compilación comparación covariables
Code
# Definir los datos correctamentedata_pam6 <-data.frame(Grupo =c('1', '2', '3', '4', '5', '6'),Macrozona_Norte =c('+', '-', NA, NA, NA, NA),Macrozona_Sur =c('-', '+', NA, NA, NA, NA),RM =c(NA, '-', NA, '+', NA, NA),Sexo_Mujeres =c('+', '-', NA, '-', '+', NA),Edad =c(NA, '+', '-', NA, NA, NA),N_ttos =c('-', '-', NA, NA, NA, '+'),Dias_en_tto =c(NA, '-', NA, NA, NA, '+'))# Asegurar que los nombres de las columnas sean válidos y no haya espacios en blancocolnames(data_pam6) <-c('Grupo', 'Macrozona\nNorte', 'Macrozona\nSur', 'RM', 'Sexo\n(Mujeres)', 'Edad', 'N°ttos', 'Dias_en\ntto.')# Derretir el dataframe para que sea adecuado para ggplot2data_melt_pam6 <- reshape2::melt(data_pam6, id.vars ='Grupo', variable.name ='Variable', value.name ='Asociación')# Reemplazar los NA por un valor vacíodata_melt_pam6$Asociación[is.na(data_melt_pam6$Asociación)] <-"\n"# Crear el gráfico con ggplotdata_melt_pam6 %>% dplyr::mutate(Variable =gsub("_", " ", Variable)) %>%ggplot(aes(x = Variable, y = Grupo, fill = Asociación)) +geom_tile(color ="white", size =0.8) +scale_fill_manual(values =c("+"="#556B2F", "-"="#E2725B", "\n"="white")) +labs(title =NULL, x ="Variables", y ="Conglomerado") +theme_minimal() +theme(#axis.text.x = element_text(angle = 45, hjust = 1),panel.grid =element_blank())+theme(axis.text.y =element_text(size =17, face ="bold"),#,margin = margin(l = 7)), # Tamaño de las etiquetas de los grupos étnicosaxis.text.x =element_text(size =17, face ="bold"), # Tamaño de las etiquetas del eje Xaxis.title.x =element_text(size =16, face ="bold"),#,margin = margin(t = -15)), # Tamaño del título del eje Xaxis.title.y =element_text(size =16, face ="bold"), # Tamaño del título del eje Yplot.title =NULL, # Tamaño y estilo del título del gráficolegend.title =element_text(size =17, face ="bold"), # Tamaño del título de la leyendalegend.spacing.y =unit(1.5, "lines"),legend.box.spacing =unit(0.5, "lines"), # Controla el espacio entre la leyenda y el gráficolegend.margin =margin(5, 5, 5, 5), legend.key.height =unit(1, "cm"), legend.text =element_text(size =15, face ="bold") # Tamaño del texto de la leyenda ) +coord_flip()ggsave("_figs/asociaciones.png", width=8.8*.8, height=5*.8, dpi=1000)
Comparación covariables con agrupamiento 6 conglomerados
Tiempo que demora esta sección: 0.1 minutos
2.1.5. Regresión
Code
multinomial <- nnet::multinom( clus_pam ~ codigo_region_rec_base + glosa_sexo * factor_inclusivo_real_hist_mas_autperc_bin + prev_benef_rec_post,data = ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], by =c("estab_homo_base"="ESTAB_HOMO"), multiple ="first") %>% dplyr::mutate(prev_benef_rec_post =fct_relevel(prev_benef_rec_post, "FONASA A")),maxit =1000, # Aumenta el número de iteracionestrace =TRUE)model_table <- gtsummary::tbl_regression(multinomial, exponentiate =TRUE)invisible("Usé la pertenencia a PPOO como binaria")model_table
# weights: 60 (45 variable)
initial value 10818.643675
iter 10 value 5847.307596
iter 20 value 5574.080348
iter 30 value 5525.522191
iter 40 value 5524.336545
iter 50 value 5524.304683
final value 5524.304601
converged
